使用 VBA 宏一次复制三行

Question

我有一个 Excel 电子表格，正在使用以前用户的 VBA 代码。此电子表格中的每个项目有四行数据，但我只想为每个项目复制 D 列中的前三个单元格并将它们粘贴到另一个工作簿中。它当前设置为复制所有内容。

每次运行时，可能会有更多或更少的项目，因此它应该只复制和粘贴有内容的单元格。

这是以前的用户开始的。它工作正常，除了我想每次都跳过复制第四个单元格。您看到的公式是因为如上所述，每次使用时可能会有更多或更少的项目，因此我们输入项目的数量，例如 4，然后宏知道要复制哪些单元格。

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim FileToOpen As Variant

Set wb1 = ActiveWorkbook
ChDrive "M:"
ChDir "M:\OpenELIS\Worksheets"
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose the Exported OE Worksheet File from The OpenELIS/Worksheets Folder", _
FileFilter:="Report Files *.xls (*.xls),")

If FileToOpen = False Then
    MsgBox "No File Specified.", vbExclamation, "ERROR"
    Exit Sub
Else
    Set wb2 = Workbooks.Open(Filename:=FileToOpen)

    'Now, copy results from wb1:
    wb1.Sheets(1).Range("D45", "D" & NumOfwells * 4 + 44 - 3).Copy

    'Now, paste to y worksheet:
    wb2.Sheets("Worksheet").Range("J2").PasteSpecial

    'Now, copy ct results from wb1:
    wb1.Sheets(1).Range("F45", "F" & NumOfwells * 4 + 44 - 3).Copy

    'Now, paste to y worksheet:
    wb2.Sheets("Worksheet").Range("L2").PasteSpecial

    'Close wb2:
    wb2.Close
    Set FileToOpen = Nothing
    Sheets(1).Activate

End If

Answer 1

您可以通过在代码中加入循环来轻松完成此操作。例如：

Dim itemsToCopy as Integer
Dim Row_wb1 as Integer
Dim Row_wb2 as Integer
Dim incrementRow as Integer
Dim EndRow as Integer

Row_wb1 = 45
Row_wb2 = 2
EndRow = NumOfwells * 4 + 44 - 3

For i=1 to itemsToCopy
    'Now, copy results from wb1 into y worksheet:
    wb2.Sheets("Worksheet").Range("J" & Row_wb2 ) = wb1.Sheets(1).Range("D" & Row_wb1 , "D" & EndRow)

    'Now, copy ct results from wb1:
    wb2.Sheets("Worksheet").Range("L" & Row_wb2 ) = wb1.Sheets(1).Range("F" & Row_wb1 , "F" & EndRow)

'Increment
Row_wb1 = Row_wb1 + incrementRow
Row_wb2 = Row_wb2 + incrementRow
EndRow = EndRow + incrementRow

'Perform these operations all over again on the next item i
Next i

您应该首先弄清楚NumOfwells * 4 + 44 - 3 指的是什么，如前所述，然后确定如何将其从 4 个范围限制到 3 个。