復制每4列並粘貼到另一張Microsoft Excel中

Question

我是VBA的新手。 實際上，我的目標是將每4列，每5列一個接一個地復制到名為USD的新工作表中。

下面是我的代碼，但它不能循環工作。

Sub CopyColumns()
    Range("A5:D9").Select '**I want to add 4 columns till the end of last column with data**
    Selection.Copy
    Sheets("Test").Select
    Sheets.Add.Name = "USD"
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Test").Select

    **'Sceond loop should be like below**
    Range("E5:H9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("USD").Select
    Range("A6").Select '**I need to paste data after last row used every time**
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

Answer 1

您需要一個循環和一種移動選擇的方法。 For循環查找While因為您不知道確切要重復多少次，對於變量，可以使用Offset或直接將它們放入Cells中以指定選擇。

Sub CopyColumns()
Dim iCycle As Long

iCycle = 0

Sheets.Add.Name = "USD"
Sheets("Test").Select

While Range("A5").Offset(0, iCycle * 4).Value <> "" 'checks if there are any values left to be copied

    Range("A5:D9").Offset(0, iCycle * 4).Copy 'Offset moves whole selection by 4 columns to the right every time
    Sheets("USD").Select
    Sheets("USD").Range(Cells(1 + iCycle * 5, 1), Cells(1 + iCycle * 5, 4)).PasteSpecial Paste:=xlPasteValues 'Cells can also be used to specify selection based on variable
    Sheets("Test").Select

    iCycle = iCycle + 1
Wend

End Sub