继续宏以继续53行

Question

Sub attempt()
'
' attempt Macro
'

'
For i = 0 To 818
    Sheets("hedz").Select
    q = (i * 4) + 1
    ActiveSheet.Range(Cells(1, q), Cells(1, q + 3)).Select
    Selection.Copy
    Sheets("Sheet1").Select
    Range("A" & i + 1).Select
    ActiveSheet.Paste
    Sheets("hedz").Select

我需要帮助重复53行，并重新粘贴sheet1上A列的每818行。我已经通过重复宏53次完成了这个，但我只是一个初学者，无法弄清楚如何。我的电子表格的副本：

Answer 1

这应该这样做：

Sub attemp()
Dim i&, j&
Dim ows As Worksheet, tws As Worksheet

Set ows = Sheets("hedz") 'Change to the sheet that has the data
Set tws = Sheets("Sheet1") 'change to the sheet where the data goes

With ows
    'this loop finds the extents of the rows and iterates
    For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
        'this loop finds the extents of the columns and iterates.
        'the step 4 jumps to every forth.
        For j = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column Step 4
            'this takes assigns the value of the four cells to the new sheet.
            tws.Cells(tws.Rows.Count, 1).End(xlUp).Offset(1).Resize(, 4).Value = .Cells(i, j).Resize(, 4).Value
        Next j
    Next i
End With

End Sub

你需要两个循环。这将找到总列数和总行数。