Eingebettete "für jede" Schleife Bedingung ist nicht wahr nach der ersten Iteration

Question

Das folgende Makro ist für das Kopieren von Inhalt von unter Spaltenüberschriften in einem Blatt (mit variabler Spaltenreihenfolge, aber gleiche Spaltennamen) auf ein anderes Blatt (eine Spalte neben ein anderes für jetzt). Das Problem ist, dass nach der ersten Iteration der eingebetteten For Each-Schleife die Bedingung "cell = header" nicht mehr wahr ist, weil "Next cell" offensichtlich noch nicht ausgeführt wurde. Gibt es einen Workaround dafür oder muss ich komplett neu schreiben?

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

Machen Sie sich von diesen langsam und nutzlos Activate und ActiveCell los!
Ich habe nicht getestet, aber das sollte besser funktionieren.

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