Looping durch dynamische benannten Bereich in VBA

Question

ich auf einem dynamischen benannten Bereich in Sheet2 "TransTypes" eine verschachtelte Schleife, die ich wie folgt definiert:

ist

=OFFSET(Sheet2!$A$1,0,0,COUNTA(Sheet2!A:A),1) 

und mein Looping wie folgt:

Sub Repeat_trans_type() 
    Dim Trans_type_count As Integer, wb As Workbook, wsMain As Worksheet, nwb As Workbook 
    Dim i As Integer, nws As Worksheet, wsSheet2 As Worksheet, j As Integer, cell As Range 
    Dim k As Integer 


    Trans_type_count = Sheet2.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count 

    Application.ScreenUpdating = False 

    Set wb = Workbooks("Book1.xlsm") 
    Set wsMain = wb.Sheets("Sheet1") 
    Set wsSheet2 = wb.Sheets("Sheet2") 

    j = 1 
    k = 1 

Set nwb = Workbooks.Add 
Set nws = nwb.Sheets(1) 

For j = 1 To 96 
     i = 1 
     Set cell = Nothing 
     For Each cell In wsSheet2.Names("TransTypes").RefersToRange.Cells    
     wsMain.Range("A" & j, "C" & j).Copy 
     nws.Range("A" & k).PasteSpecial xlPasteValues 
     nws.Range("A" & k).PasteSpecial xlPasteFormats 
     wsSheet2.Range("A" & i).Copy 
     nws.Range("D" & k).PasteSpecial xlPasteValues 
     nws.Range("D" & k).PasteSpecial xlPasteFormats 
     i = i + 1 
     k = k + 1 
    Next cell 
    Next j 
End Sub 

die erste Iteration der verschachtelten Schleife funktioniert gut, aber wenn es beginnt für zweites Mal ausgeführt wird, dh j = 2, erhalte ich die Fehlermeldung:

Application-defined or object-defined error 

Ab jetzt habe ich mit Hilfe unten, um diesen gearbeitet:

For Each cell In wsSheet2.Range("A1", wsSheet2.Range("A1").End(xlDown)) 

statt direkt den benannten Bereich verwenden.

Alle Ideen, warum die Offset-Ansatz nicht funktioniert, würde geschätzt.

Danke.

Answer 1

Schwer zu sagen, was ist hier falsch, aber ich schlage vor, Sie versuchen Sie Folgendes:

• Verwendung For Each cell In wsSheet2.Range("TransTypes").Cells in für/each

---

For j = 1 To 96 
    i = 1 
    Set cell = Nothing 
    For Each cell In wsSheet2.Range("TransTypes").Cells 'changed this line (2) 
     wsMain.Range("A" & j, "C" & j).Copy 
     nws.Range("A" & k).PasteSpecial xlPasteValues 
     nws.Range("A" & k).PasteSpecial xlPasteFormats 
     wsSheet2.Range("A" & i).Copy 
     nws.Range("D" & k).PasteSpecial xlPasteValues 
     nws.Range("D" & k).PasteSpecial xlPasteFormats 
     i = i + 1 
     k = k + 1 
    Next cell 
Next j