Excel Kopieren von Daten in vielen Spalten

Question

ich diese Excel-Makro haben:

Sub test() 
    Dim LR As Long, i As Long, buf 
    LR = Cells(Rows.Count, 2).End(xlUp).Row 
    For i = 3 To LR 
    If Cells(i, 25).Value <> "" Then 
    buf = Cells(i, 25).Value 
    Else 
    Cells(i, 25).Value = buf 
    End If 
    Next 
End Sub 

Dies mich dies in der DAT-1-Säule zu tun hilft:

ID  LABEL DAT 1 DAT 2 DAT 3 DAT 4 DAT 5 DAT 6 DAT 7 
1330102 10171 12:02 12:08 13:00 14:24 14:40 15:30 16:28 
1329807 9598 11:57 12:20 13:05 14:10 14:22 15:02 15:35 
1329807 9598 11:57      
1329807 9598 11:57      
1331864 9608 15:49 16:02 16:12 17:13 17:25 18:56 19:14 
1329708 9608 15:49      
5001021 98327 13:30 13:22 13:32 14:09 14:19 14:54 15:13 
1307566 98327 13:30      
1306925 98327 13:30      
1307574 98327 13:30 

Ich brauche dies zu tun: (Kopie der gleicher Wert in mehreren Spalten und Zeilen). DAT 2, DAT 3, DAT 4, DAT 5, DAT 6, DAT 7.

ID  LABEL DAT 1 DAT 2 DAT 3 DAT 4 DAT 5 DAT 6 DAT 7 
1330102 10171 12:02 12:08 13:00 14:24 14:40 15:30 16:28 
1329807 9598 11:57 12:20 13:05 14:10 14:22 15:02 15:35 
1329807 9598 11:57 12:20 13:05 14:10 14:22 15:02 15:35  
1329807 9598 11:57 12:20 13:05 14:10 14:22 15:02 15:35 
1331864 9608 15:49 16:02 16:12 17:13 17:25 18:56 19:14 
1329708 9608 15:49 16:02 16:12 17:13 17:25 18:56 19:14  
5001021 98327 13:30 13:22 13:32 14:09 14:19 14:54 15:13 
1307566 98327 13:30 13:22 13:32 14:09 14:19 14:54 15:13 
1306925 98327 13:30 13:22 13:32 14:09 14:19 14:54 15:13 
1307574 98327 13:30 13:22 13:32 14:09 14:19 14:54 15:13 

Irgendwelche Ideen für die Implementierung der Lösung ...?

Answer 1

Schleife über die Spalten und Schleife über die Zeilen innerhalb dieser Schleife?

Sub test() 
    Dim LR As Long, i As Long 
    Dim LC As Long 
    Dim c As Long 
    LR = Cells(Rows.Count, 2).End(xlUp).Row 
    LC = Cells(2, Columns.Count).End(xlToLeft).Column ' Assuming row 2 is your headers 
    For c = 25 To LC ' Assuming that column Y is first column to be processed 
     For i = 3 To LR 
      If Cells(i, c).Value = "" Then 
       Cells(i, c).Value = Cells(i - 1, c).Value 
      End If 
     Next 
    Next 
End Sub