Question

我有一个VBA脚本，它以下列方式循环：

如果单元格值为3，那么它将粘贴第1行3次，第2行粘贴3次等

当前粘贴范围如下所示：

Line 1
Line 1
Line 1

Line 2
Line 2
Line 2

Line 3
Line 3
Line 3

我想知道VBA脚本是否可以粘贴数据，因此数据是这样的：

Line 1
Line 2
Line 3

Line 1
Line 2
Line 3

Line 1
Line 2
Line 3

VBA脚本驱动上述内容如下：

Sub CopyJournalLines2()

Dim wsInv As Worksheet

Dim i As Integer

Dim j As Integer
Dim iStartRow As Integer
Dim iNumCopies As Integer
Dim iCopyRow As Integer
Dim CopyRange As Range
Dim PasteRange As Range

Set wsInv = ThisWorkbook.Sheets("Invoice Upload")

With wsInv
.Rows("17:5000").Cells.Clear
iStartRow = 17
iNumCopies = .Range("O12").Value
For i = 1 To 4
    Set CopyRange = .Range(.Cells(i, 1), .Cells(i, 17))
    iCopyRow = iStartRow + (i - 1) * iNumCopies
    Set PasteRange = .Range(.Cells(iCopyRow, 1), .Cells(iCopyRow, 17))
    PasteRange.Formula = CopyRange.Formula

    For j = 2 To iNumCopies
        iCopyRow = iStartRow + j - 1 + (i - 1) * iNumCopies
        .Range(.Cells(iCopyRow, 1), .Cells(iCopyRow, 17)).FormulaR1C1 = PasteRange.FormulaR1C1

    Next j
Next i
End With
End Sub

Answer 1

实际上，问你的代码要简单得多，因为你只是粘贴相同的4行iNumCopies次。

经过全面测试的代码：

Sub CopyJournalLines2()

Dim wsInv As Worksheet

Dim i As Integer, j As Integer
Dim iNumCopies As Integer, iCopyRow As Integer, iStartRow As Integer
Dim CopyRange As Range, PasteRange As Range

Set wsInv = ThisWorkbook.Sheets("Invoice Upload")

With wsInv

    .Rows("17:5000").Cells.Clear
    iStartRow = 17
    iNumCopies = .Range("O12").Value

    j = 0

    For i = 1 To iNumCopies

        .Range(.Range("A" & iStartRow).Offset(j), .Range("Q" & iStartRow + j + 3)).FormulaR1C1 = .Range("A1:Q4").FormulaR1C1

        'to paste formats and values use the following code
        '.Range("A1:Q4").Copy
        '.Range(.Range("A" & iStartRow).Offset(j), .Range("Q" & iStartRow + j + 3)).PasteSpecial xlPasteValues
        '.Range(.Range("A" & iStartRow).Offset(j), .Range("Q" & iStartRow + j + 3)).PasteSpecial xlPasteFormats

         j = j + 4

    Next i


End With

End Sub

更改VBA脚本粘贴数据的方式

1 个答案: