Sub HZ() Dim sj(), i% ReDim sj(Sheets.Count - 2, 5): i = -1 For Each sh In Sheets If sh.Name <> ActiveSheet.Name And sh.[i3] <> "" Then i = i + 1 sj(i, 0) = sh.Name sj(i, 1) = sh.[i3] sj(i, 2) = sh.[e4] sj(i, 3) = sh.[i4] sj(i, 4) = sh.[e5] sj(i, 5) = sh.[d7] End If Next If i > -1 Then ActiveSheet.[a2].Resize(i + 1, 6) = sj End Sub
假設彙總表和各房號表位於同一個檔案，則：
房號這列用手工填，然後，B:F分別輸入
B2輸入
=INDIRECT(A2&"!I3")&""
C2輸入
=INDIRECT(A2&"!E4")
D2輸入
=INDIRECT(A2&"!I4")
E2輸入
=INDIRECT(A2&!E5")
F2輸入
=INDIRECT(A2&"!D7")
然後，選中B2：F2，下拉填充公式即可。
如果不想手工輸入房號，則在這個檔案中再新建一個工作表，按【ALT+F11】，雙擊左側樹形結構中新建的工作表，將下述程式碼貼上到右側編輯區，執行主選單中“執行”——“執行子過程/使用者窗體”，即可得到你要的結果。
Sub HZ() Dim sj(), i% ReDim sj(Sheets.Count - 2, 5): i = -1 For Each sh In Sheets If sh.Name <> ActiveSheet.Name And sh.[i3] <> "" Then i = i + 1 sj(i, 0) = sh.Name sj(i, 1) = sh.[i3] sj(i, 2) = sh.[e4] sj(i, 3) = sh.[i4] sj(i, 4) = sh.[e5] sj(i, 5) = sh.[d7] End If Next If i > -1 Then ActiveSheet.[a2].Resize(i + 1, 6) = sj End Sub