将数据从行复制到另一个工作簿

Question

我想在主表中手动选择范围，然后单击按钮，将选择的数据复制到另一个工作簿中。下面是我尝试的代码，但每次都出错。我想问题是我不需要打开Master工作簿的行，因为它将每次打开。此外，我不知道如何设置复制和粘贴范围。

我会很感激任何建议！

 Sub foo()
Dim x As Workbook, y As Workbook

'## Open both workbooks first:
Set y = Workbooks.Open("C:\Users\Jakub\Desktop\Proforma.xlsm")
Set x = Workbooks.Open("C:\Users\Jakub\Desktop\MasterDATABASE.xlsm")

'Now, copy what you want from x:
Dim copyRng As Range
Set copyRng = Application.InputBox(Prompt:="Please select a range to be copied.", Title:="select range", Type:=8)

copyRng.Range("A1").Copy Destination:=y.Sheets("proforma").Range("B2")
copyRng.Range("C1").Copy Destination:=y.Sheets("proforma").Range("B3")
copyRng.Range("D1").Copy Destination:=y.Sheets("proforma").Range("B4")
copyRng.Range("B:B").Copy Destination:=y.Sheets("proforma").Range("A10")
copyRng.Range("E:E").Copy Destination:=y.Sheets("proforma").Range("C10")

End Sub

Answer 1

使用Application.InputBox（）：

Sub foo()
    Dim x As Workbook, y As Workbook

    '## Open both workbooks first:
    Set y = Workbooks.Open("C:\Users\Jakub\Desktop\Proforma.xlsm")
    Set x = Workbooks.Open("C:\Users\Jakub\Desktop\MasterDATABASE.xlsm")

'Now, copy what you want from x:
    Dim copyRng As Range
    Set copyRng = Application.InputBox(Prompt:="Please select a range to be copied.", Title:="select range", Type:=8)

    copyRng.Copy Destination:= y.Sheets("proforma").Range("A1")

   'Close x:
   x.Close
End Sub

您可能需要添加一些代码来检查用户是否选择了有效范围（请注意我打开了x作为第二个工作簿，让用户“激活”它以便选择一个范围）

Answer 2

更改，

copyRng.Range("B1:B999999").Copy Destination:=y.Sheets("proforma").Range("A10:A999999")

要，

copyRng.columns(2).Copy Destination:=y.Sheets("proforma").Range("A10")
copyRng.columns(5).Copy Destination:=y.Sheets("proforma").Range("C10")

您正在处理选定的单元格，以便您可以选择整个列。

您可能不希望在原始选择的A，C和C列中留下诸如更改之类的错误。 D给用户。如果A，C或D发生变化，这将需要一个循环退出。

...
dim s as long, d as long
d = 10
with y.Sheets("proforma")
    .Range("B2") = copyRng.Range("A1").value
    .Range("B3") = copyRng.Range("C1").value
    .Range("B4") = copyRng.Range("D1").value
    for s = 1 to copyRng.Rows.count
        if copyRng.cells(s, "A") = .Range("B2") and _
           copyRng.cells(s, "C") = .Range("B3") and _
           copyRng.cells(s, "D") = .Range("B4") then
            .Range("A" & d) = copyRng.cells(s, "B").value
            .Range("C" & d) = copyRng.cells(s, "E").value
            d = d + 1
        else
            exit for
        end if
    next s
end with