從多個工作表複製並粘貼到工作表1

Question

我想從多個工作表中獲取數據並粘貼到工作表1中，但我的代碼無法正常工作。它不斷地從表格「表格1」一遍又一遍地複製。有人知道我的代碼有什麼問題嗎？

感謝

Option Explicit 

Sub test() 

Dim ws As Worksheet 
Dim i As Integer 

    For Each ws In ThisWorkbook.Worksheets 
     If ws.Name <> "Table 1" Then 

      ActiveSheet.Range("A15:X35").Select 
      Selection.Copy 

      Worksheets("Table 1").Activate 

       For i = 1 To 5000 

        If IsEmpty(Cells(i, 1)) = True And IsEmpty(Cells(i + 1, 1)) = True Then 
        ActiveSheet.Cells(i, 1).Select 
        ActiveSheet.Paste 
        Exit For 
        End If 

       Next i 

     End If 
    Next ws 

End Sub 

Answer 1

裏面你的循環，你是從ActiveSheet從ws複製，沒有。如果activeSheet是「表1」（事實上，你自己在聲明Worksheets("Table 1").Activate中激活表1），那麼當然如果將繼續從它複製。

此外，不使用激活和選擇直接從範圍複製總是更好。我想這是你想要做的：

With Worksheets("Table 1") 
    For Each ws In ThisWorkbook.Worksheets 
     If ws.Name <> "Table 1" Then 
      For i = 1 To 5000 
       If IsEmpty(.Cells(i, 1)) And IsEmpty(.Cells(i + 1, 1)) Then 
        ws.Range("A15:X35").Copy .Cells(i, 1) 
        Exit For 
       End If 
      Next i 
     End If 
    Next ws 
End With