将所有列从多个工作表合并到另一个工作表

Question

我是VBA的新手。附带的是带有虚拟数据的模板。我想遍历多个工作表（Data1-Data4）中的所有列并创建统一表。我该如何修改代码，而不是每隔4列再循环一次，使其看起来像工作表“ Expected Result”？

欢迎任何想法/建议。

Sub TestMacro()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim path As String, fileName As String
Dim lastRowInput As Long, lastRowOutput As Long, rowCntr As Long, lastColumn As Long
Dim inputWS1 As Worksheet, inputWS2 As Worksheet, inputWS3 As Worksheet, inputWS4 As Worksheet, outputWS As Worksheet

'set your sheets here
Set inputWS1 = ThisWorkbook.Sheets("Data1")
Set inputWS2 = ThisWorkbook.Sheets("Data2")
Set inputWS3 = ThisWorkbook.Sheets("Data3")
Set inputWS4 = ThisWorkbook.Sheets("Data4")
Set outputWS = ThisWorkbook.Sheets("Test")
rowCntr = 1

'get last rows from both sheets
lastRowInput = inputWS1.Cells(Rows.Count, "A").End(xlUp).row
lastRowOutput = outputWS.Cells(Rows.Count, "A").End(xlUp).row
lastColumn = inputWS1.Cells(1, Columns.Count).End(xlToLeft).Column

'copy data from columns
inputWS1.Range("A1:B" & lastRowInput).Copy outputWS.Range("A" & lastRowOutput + 1)

inputWS1.Range("C1:C" & lastRowInput).Copy outputWS.Range("F" & lastRowOutput + 1)
inputWS1.Range("D1:D" & lastRowInput).Copy outputWS.Range("J" & lastRowOutput + 1)
inputWS1.Range("E1:E" & lastRowInput).Copy outputWS.Range("N" & lastRowOutput + 1)

inputWS2.Range("B1:B" & lastRowInput).Copy outputWS.Range("C" & lastRowOutput + 1)
inputWS2.Range("C1:C" & lastRowInput).Copy outputWS.Range("G" & lastRowOutput + 1)
inputWS2.Range("D1:D" & lastRowInput).Copy outputWS.Range("K" & lastRowOutput + 1)
inputWS2.Range("E1:E" & lastRowInput).Copy outputWS.Range("O" & lastRowOutput + 1)

inputWS3.Range("B1:B" & lastRowInput).Copy outputWS.Range("D" & lastRowOutput + 1)
inputWS3.Range("C1:C" & lastRowInput).Copy outputWS.Range("H" & lastRowOutput + 1)
inputWS3.Range("D1:D" & lastRowInput).Copy outputWS.Range("L" & lastRowOutput + 1)
inputWS3.Range("E1:E" & lastRowInput).Copy outputWS.Range("P" & lastRowOutput + 1)

inputWS4.Range("B1:B" & lastRowInput).Copy outputWS.Range("E" & lastRowOutput + 1)
inputWS4.Range("C1:C" & lastRowInput).Copy outputWS.Range("I" & lastRowOutput + 1)
inputWS4.Range("D1:D" & lastRowInput).Copy outputWS.Range("M" & lastRowOutput + 1)
inputWS4.Range("E1:E" & lastRowInput).Copy outputWS.Range("Q" & lastRowOutput + 1)

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

https://filebin.net/piqyg9s3vtl8yepm