Excel VBA复制从一个工作表到另一个行逐行到固定数量的行

我需要将工作表的第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，所以它们不会重叠。 你可以试试看看它是否适用于你的数据？