1，程式為：

Sub 提取第二行()

Dim wks As Worksheet, sht As Worksheet

On Error Resume Next

Set wks = Worksheets("彙總表")

If Err 0 Then Worksheets.Add(before:=Sheets(1)).Name = "彙總表"

For Each sht In Sheets

If sht.Name "彙總表" Then

sht.Range("A2").EntireRow.Copy Sheets("彙總表").Range("A" & Sheets("彙總表").Cells(Rows.Count, 1).End(xlUp).Row + 1)

End If

Next

End Sub

2，如果沒有彙總表則新建彙總表。將非彙總表的其他表裡面的第二行分別複製並貼上進彙總表，貼上位置為A列的第一個空白行。