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个。

使用VBA宏一次复制三行

1 个答案: