Question

我使用下面的代码从下拉列表中复制粘贴，但它粘贴了列中的所有表。我想粘贴两列等间距，以便轻松打印。

Sub Cha()

Dim dvCell As Range
Dim inputRange As Range
Dim c As Range
Dim i As Long

Set dvCell = Worksheets("Summary-Chentir").Range("Q4")
Set inputRange = Worksheets("Names").Range("I3:I20")

i = 1
inc = 0

For Each c In inputRange
    dvCell = c.Value 
    Sheets("Summary-Chentir").Select
    Range("L2:R21").Select
    Selection.Copy
    Sheets("Paste").Select
    Cells(i + 1 + inc, 1).Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, 
    Operation:=xlNone, 
    SkipBlanks:=False, Transpose:=False
    i = i + 1
    inc = inc + 22
    Next c

End Sub

Answer 1

您可以尝试：

Sub Cha()
    Dim dvCell As Range
    Dim inputRange As Range
    Dim c As Range
    Dim i As Long
    Set dvCell = Worksheets("Summary-Chentir").Range("Q4")
    Set inputRange = Worksheets("Names").Range("I3:I20")
    i = 1
    inc = 0
    For Each c In inputRange
        dvCell = c.Value 
        Sheets("Summary-Chentir").Range("L2:R21").Copy
        Sheets("Paste").Cells(i + 1 + inc, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        i = i + 1
        inc = inc + 22
    Next c
End Sub

将使用For循环，而不是For Each循环，因为我将建议如何执行此操作。

Dim i as Long, j as Long, dvCell As Range
Set dvCell = Worksheets("Summary-Chentir").Range("Q4")
For i = 3 to 20
    dvCell = Sheets("Names").Cells(i,"I").Value
    If i Mod 2 = 0 Then
        j = 2
    Else
        j = 1
    End If
    Sheets("Summary-Chentir").Range("L2:R21").Copy
    Sheets("Paste").Cells(i + 1 + inc, j).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    If i Mod 2 = 0 Then inc = inc + 22
Next i

VBA复制粘贴在两列

1 个答案: