Excel VBA从一个工作表复制到另一行，最多固定行数

Question

我需要将工作表的第 2 行（导入设置）复制到另一个工作表的第 2 行（导入）然后我需要复制导入设置工作表下一行的 LO 列并将其附加到第 2 行的末尾在导入工作表上是 L 列中的数量大于 0。我需要继续将导入设置表上的下一行中的 LO 列复制到导入表中，直到我复制 98 行，然后我需要复制整行导入设置表上的下一行到导入表的第 3 行并继续如上，直到我达到 98，然后再次重复该过程。我知道我在这里的东西会起作用，但我正在寻找一种更简单的方法，然后不得不输入这么多代码。

Sub Create_invoice()

' Copies the first row of an invoice to the import template

    Sheets("Import Setup").Select
    Range("A2:O2").Select
    Application.CutCopyMode = False
Selection.Copy
Sheets("Import").Select
Range("A2").Select
ActiveSheet.Paste

'Calls macro to copy additional Distributions up to 99

Call Copy_Distribution

End Sub

Sub Copy_Distribution()

'Copys distribution if invoice amount is not 0 up to 99

 Sheets("Import Setup").Select
 If Range("L3").Value > 0 Then
  Range("L3:O3").Select
 Application.CutCopyMode = False
 Selection.Copy
 Sheets("Import").Select
 Range("P2").Select
 ActiveSheet.Paste
 End If

 Sheets("Import Setup").Select
 If Range("L4").Value > 0 Then
 Range("L4:O4").Select
 Application.CutCopyMode = False
 Selection.Copy
 Sheets("Import").Select
 Range("T2").Select
 ActiveSheet.Paste
 End If

 Sheets("Import Setup").Select
 If Range("L5").Value > 0 Then
 Range("L5:O5").Select
 Application.CutCopyMode = False
 Selection.Copy
 Sheets("Import").Select
 Range("X2").Select
 ActiveSheet.Paste
 End If

 Sheets("Import Setup").Select
 If Range("L6").Value > 0 Then
 Range("L6:O6").Select
 Application.CutCopyMode = False
 Selection.Copy
 Sheets("Import").Select
 Range("AB2").Select
 ActiveSheet.Paste
 End If

 Sheets("Import Setup").Select
 If Range("L7").Value > 0 Then
 Range("L7:O7").Select
 Application.CutCopyMode = False
 Selection.Copy
 Sheets("Import").Select
 Range("AF2").Select
 ActiveSheet.Paste
 End If

 Sheets("Import Setup").Select
 If Range("L8").Value > 0 Then
 Range("L8:O8").Select
 Application.CutCopyMode = False
 Selection.Copy
 Sheets("Import").Select
 Range("AJ2").Select
 ActiveSheet.Paste
 End If

 Sheets("Import Setup").Select
 If Range("L9").Value > 0 Then
 Range("L9:O9").Select
 Application.CutCopyMode = False
 Selection.Copy
 Sheets("Import").Select
 Range("AN2").Select
 ActiveSheet.Paste
 End If

 Sheets("Import Setup").Select
 If Range("L10").Value > 0 Then
 Range("L10:O10").Select
 Application.CutCopyMode = False
 Selection.Copy
 Sheets("Import").Select
 Range("AR2").Select
 ActiveSheet.Paste
 End If

 Sheets("Import Setup").Select
 If Range("L11").Value > 0 Then
 Range("L11:O11").Select
 Application.CutCopyMode = False
 Selection.Copy
 Sheets("Import").Select
 Range("AV2").Select
 ActiveSheet.Paste
 End If

 Sheets("Import Setup").Select
 If Range("L12").Value > 0 Then
 Range("L12:O12").Select
 Application.CutCopyMode = False
 Selection.Copy
 Sheets("Import").Select
 Range("AZ2").Select
 ActiveSheet.Paste
 End If

 Sheets("Import Setup").Select
 If Range("L13").Value > 0 Then
 Range("L13:O13").Select
 Application.CutCopyMode = False
 Selection.Copy
 Sheets("Import").Select
 Range("BD2").Select
 ActiveSheet.Paste
 End If


End Sub

Answer 1

这里是循环

Sub Copy_Distribution()
Dim OriginSheet As Worksheet
Set OriginSheet = Sheets("Import Setup")
Dim ObjectiveSheet As Worksheet
Set ObjectiveSheet = Sheets("Import")
Dim ColumnToPaste As Long
Dim RowToGetValue As Long
Dim GetColumn As Long
ColumnToPaste = 15 'Because GetColumn
For RowToGetValue = 3 To 98 'From 3 to 98 right?
    If OriginSheet.Cells(RowToGetValue, 12).Value > 0 Then
        For GetColumn = 1 To 4
            ObjectiveSheet.Cells(2, ColumnToPaste + GetColumn).Value = OriginSheet.Cells(RowToGetValue, 11 + GetColumn).Value
        Next GetColumn
    ColumnToPaste = ColumnToPaste + 4
    End If
Next RowToGetValue

End Sub

我将范围替换为动态范围，从第 3 行到第 98 行，并使列的增量为 4，因此它们不会重叠。 你能试试看它是否适用于你的数据吗？