Sub 合并工作表()
 Dim sh As Worksheet, flag As Boolean, i As Integer, hrow As Integer, hrowc As Integer
 For i = 1 To Sheets.Count
 If Sheets(i).Name = "合并数据" Then flag = True
 Next
 If flag = False Then
 Set sh = Worksheets.Add
 sh.Name = "合并数据"
 Sheets("合并数据").Move after:=Sheets(Sheets.Count)
 End If
 For i = 1 To Sheets.Count
 If Sheets(i).Name <> "合并数据" Then
 hrow = Sheets("合并数据").UsedRange.Row
 hrowc = Sheets("合并数据").UsedRange.Rows.Count
 If hrowc = 1 Then
 Sheets(i).UsedRange.Copy Sheets("合并数据").Cells(hrow, 1).End(xlUp)
 Else
 Sheets(i).UsedRange.Copy Sheets("合并数据").Cells(hrow + hrowc - 1, 1).Offset(1, 0)
 End If
 End If
 Next i
 End Sub