透過VBA複製多個活頁簿的資料到指定活頁簿。

Sub RowsCopyPasteCrossSheets_Click()

Dim targetSheetName As String

Dim targetColumnsRowNumber As Integer

Dim targetColumnsCount As Integer

Dim sourceSheetNameList(5) As String

Dim sourceSheetName As String

Dim sourceColumnsRowNumber As Integer

Dim lastPasteRowNumber As Integer

Dim tempRowNumber As Integer

targetSheetName = "TargetPasteSheet"

targetColumnsRowNumber = 1	'The row number of target sheet's columns

sourceSheetNameList(1) = "SourceCopySheet1"

sourceSheetNameList(2) = "SourceCopySheet2"

sourceSheetNameList(3) = "SourceCopySheet3"

sourceSheetNameList(4) = "SourceCopySheet4"

sourceSheetNameList(5) = "SourceCopySheet5"

sourceColumnsRowNumber = 1	'The row number of source sheet's columns

targetColumnsCount = Worksheets(targetSheetName).Cells(targetColumnsRowNumber, Worksheets(targetSheetName).Columns.Count).End(xlToLeft).Column

lastPasteRowNumber = targetColumnsRowNumber + 1

' Clear target sheet data

Worksheets(targetSheetName).Range(Worksheets(targetSheetName).Cells(lastPasteRowNumber, 1), Worksheets(targetSheetName).Cells(lastPasteRowNumber, targetColumnsCount)).Delete

' Copy source sheets's data to target sheet

For i = 1 To UBound(sourceSheetNameList)

sourceSheetName = sourceSheetNameList(i)

' Get last row number of source sheet

tempRowNumber = Worksheets(sourceSheetName).Cells(Worksheets(sourceSheetName).Rows.Count, 1).End(xlUp).Row

' If source sheet have data, copy source data and paste to target sheet

If tempRowNumber > sourceColumnsRowNumber Then

Worksheets(sourceSheetName).Range("A" & CStr(sourceColumnsRowNumber + 1), Chr(64 + targetColumnsCount) & CStr(tempRowNumber)).Copy

Worksheets(targetSheetName).Range("A" & CStr(lastPasteRowNumber)).PasteSpecial xlPasteValues

lastPasteRowNumber = lastPasteRowNumber + tempRowNumber - sourceColumnsRowNumber

End If

Next i

End Sub