因為你沒有上傳檔案，我就自己填了些資料以便測試（假設有3張需要提取的表，1張彙總表）：

表一資料：

表二資料：

表三資料：

生成結果如下：

沒理解錯的話你要的應該就是這個效果。

貼上程式碼吧：

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False

Dim SheetCount As Integer, SheetR As Integer, SheetC As Integer, i As Integer, j As Integer, m As Integer, n As Integer

SheetCount = Sheets.Count

n = 1

For i = 1 To SheetCount - 1

SheetR = Sheets(i).UsedRange.Rows.Count

SheetC = Sheets(i).UsedRange.Columns.Count

For j = 1 To SheetR

For m = 1 To SheetC

If Sheets(i).Cells(j, m) Like "*圓*" Or Sheets(i).Cells(j, m) Like "*長*" Then

Sheets(SheetCount).Range("A" & n) = Sheets(i).Cells(j, m)

n = n + 1

Else

End If

Next m

Next j

Next i

Application.ScreenUpdating = True

End Sub