Question

我是VBA的新手。实际上，我的目标是将每4列一行一行地复制到一个名为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循环查找虽然您不知道要重复代码的次数和变量，但您可以使用Offset或直接将它们放入单元格以指定选择。

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

复制每4列并粘贴另一张Microsoft Excel

1 个答案: