第一次迭代后嵌入的“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