从左到右合并工作表，而不是使用范围方法自上而下

Question

我只是喜欢打开几个源文件(所有Excel(，并始终将完整的数据ROM Sheet 1复制到我的目标表中。第一部分效果很好。

不寻常的是，我希望表格从左到右(水平(合并，而不是从上到下合并。当然，范围需要动态调整。分配部分也在工作。不起作用的是将其复制到我的目标工作表上，并始终从左到右添加。

方法工作表 1 有来自 A1：C10 的数据工作表 2 包含来自 A1：B20 的数据

应该像

工作表 1 包含来自 A1：C10 -> A1：C10 的数据工作表 2 包含来自 A1：B20 -> D1：E20 的数据

等。我不能这样做。它要么给我一个 1004，要么说对象不支持该方法。

代码如下：

 Application.ScreenUpdating = False 'Das "Flackern" ausstellen
 Set oTargetSheet = ActiveWorkbook.Sheets.Add
 lErgebnisSpalte = 1
 sPfad = "C:UsersTEST"
 sDatei = Dir(CStr(sPfad & "*.xl*")) 
 Do While sDatei <> ""

     Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 
     z1 = oSourceBook.Sheets(1).UsedRange.Rows.Count
         s1 = oSourceBook.Sheets(1).UsedRange.Columns.Count
**oSourceBook.Sheets(1).Range(oSourceBook.Cells(1, 1), oSourceBook.Cells(z1, s1)).Copy oTargetSheet.Range(oTargetSheet.Cells(1, lErgebnisSpalte), oTargetSheet.Cells(z1, s1))**
    lErgebnisSpalte = lErgebnisSpalte + 1
    oSourceBook.Close False 'nicht speichern
     'Next File
     sDatei = Dir()
 Loop
 Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
 'Variablen aufräumen
 Set oTargetSheet = Nothing
     Set oSourceBook = Nothing
End Sub

调试一直说：对象不支持该方法;并标记此行：

**oSourceBook.Sheets(1).Range(oSourceBook.Cells(1, 1), oSourceBook.Cells(z1, s1)).Copy oTargetSheet.Range(oTargetSheet.Cells(1, lErgebnisSpalte), oTargetSheet.Cells(z1, s1))**

Answer 1

这对

我有用(在这种情况下，我只是将现有范围复制到下一个免费列中(

Private Sub Worksheet_Activate()
Dim colNr As Integer
For i = 1 To 100
colNr = ThisWorkbook.ActiveSheet.Range("A1").End(xlToRight).Column
colNr = colNr + 1
ThisWorkbook.ActiveSheet.Range("A1:B5").Copy Destination:=ThisWorkbook.ActiveSheet.Cells(1, colNr)
Next i
End Sub

我希望这有所帮助。