第一次迭代後嵌入「for each」循環條件不成立

Question

下面的宏用於將一個表格（列可變順序，但列名相同）的列標題下的內容複製到另一個表格另一個現在）。問題是，在嵌入For Each循環的第一次迭代之後，條件「cell = header」不再是真的，因爲「Next cell」顯然還沒有執行。有沒有解決方法，或者我必須完全重寫？

Sub CopyContentBelowHeadersToAnotherSheet() 

Dim headers As Range 
Dim cell As Variant 
Dim header As Variant 
Dim CopiedHeaders As Variant 
Dim is as Variant 



Set headers = Workbooks("GL audit template 3.0.xlsm").Worksheets ("Sheet3").Range("A1:Z1") 
CopiedHeaders = Array("DocumentNo", "G/L", "Type", "Tx", "Text", "BusA", "Doc. Date", "Amount in local cur.") 
i = 1 

For Each cell In headers 
    For Each header In CopiedHeaders 
     If cell = header Then ' this is no longer true after first iteration of this loop 
      cell.Offset(1, 0).Activate 
      Range(ActiveCell, ActiveCell.End(xlDown)).Copy 
      Workbooks("GL audit template 3.0.xlsm").Worksheets("Sheet1").Activate 
      Cells(2, i).Activate 
      ActiveSheet.Paste 
      i = i + 1 
     End If 
    Next header 
Next cell 

End Sub 

Answer 1

請擺脫那些緩慢的和無用的Activate和ActiveCell的！
我還沒有測試過，但這應該會更好。

For Each cell In headers 
    For Each header In CopiedHeaders 
     If cell = header Then ' this is no longer true after first iteration of this loop 
      With cell 
      Range(.Offset(1, 0), .Offset(1, 0).End(xlDown)).Copy 
      Workbooks("GL audit template 3.0.xlsm").Worksheets("Sheet1").Cells(2, i).Paste 
      End with 
      i = i + 1 'edited 
     End If 
    Next header 
Next cell