Schleife überträgt Daten aus der letzten Zeile nur

Question

Ich versuche, Daten von einem Blatt zum anderen in Format zu übertragen, wie in den Abbildungen gezeigt. Die Länge der Daten in Blatt 1 ist unbekannt. Der Code, den ich verwende, wird die Daten in das richtige Format bringen, aber alle Daten enden als Daten aus der letzten Zeile.

For b = 1 To l - 1 Step 1 
    For c = 0 To (l - 2) * 4 Step 4 

     idvalue = Sheet1.Cells(b + 1, 1).Value 
     Sheet3.Cells(c + 1, 2).Value = idvalue 
     namevalue = Sheet1.Cells(b + 1, 2).Value 
     Sheet3.Cells(c + 2, 2).Value = namevalue 
     amountvalue = Sheet1.Cells(b + 1, 3).Value 
     Sheet3.Cells(c + 3, 2).Value = amountvalue 
     commentsvalue = Sheet1.Cells(b + 1, 4).Value 
     Sheet3.Cells(c + 4, 2).Value = commentsvalue 

    Next c 
Next b 

Answer 1

Hier ist eine Lösung, die der Code viel leichter zu lesen macht.

Offensichtlich werden Sie auch die For-Schleife ändern müssen Erklärung zu welcher Startreihe/Ende Zeile erforderlich ist.

Sub Example() 

Dim lNewRow As Long 
Dim lOldRow As Long 

lNewRow = 1 

For lOldRow = 2 To 7 

    With Sheets("Sheet3") 

     .Cells(lNewRow, 1) = "ID" 
     .Cells(lNewRow, 2) = Sheets("Sheet1").Cells(lOldRow, 1) 

     .Cells(lNewRow + 1, 1) = "NAME" 
     .Cells(lNewRow + 1, 2) = Sheets("Sheet1").Cells(lOldRow, 2) 

     .Cells(lNewRow + 2, 1) = "AMT" 
     .Cells(lNewRow + 2, 2) = Sheets("Sheet1").Cells(lOldRow, 3) 

     .Cells(lNewRow + 3, 1) = "COMMENTS" 
     .Cells(lNewRow + 3, 2) = Sheets("Sheet1").Cells(lOldRow, 4) 

    End With 

    lNewRow = lNewRow + 4 

Next 

End Sub