Excel VBA 宏将复制一系列单元格并粘贴到另一个工作簿中

Posted 2023-04-13

【中文标题】Excel VBA 宏将复制一系列单元格并粘贴到另一个工作簿中

【英文标题】：Excel VBA macro that will copy a range of cells and paste into another workbook

【发布时间】：2018-10-16 13:20:45

【问题描述】：

我正在尝试为电子表格制作一个宏，该宏将从另一个电子表格的第一列导入值。我找到了一个可以手动执行的宏，但如果可能的话，我想将其设为自动过程，以便只需单击一个按钮即可更新。下面是我找到的原始宏：

    Sub ImportDatafromotherworksheet()
        Dim wkbCrntWorkBook As Workbook
        Dim wkbSourceBook As Workbook
        Dim rngSourceRange As Range
        Dim rngDestination As Range
        Set wkbCrntWorkBook = ActiveWorkbook
        With Application.FileDialog(msoFileDialogOpen)
            .Filters.Clear
            .Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
            .AllowMultiSelect = False
            .Show
            If .SelectedItems.Count > 0 Then
                Workbooks.Open .SelectedItems(1)
                Set wkbSourceBook = ActiveWorkbook
                Set rngSourceRange = Application.InputBox(prompt:="Select source range", Title:="Source Range", Default:="A1", Type:=8)
                wkbCrntWorkBook.Activate
                Set rngDestination = Application.InputBox(prompt:="Select destination cell", Title:="Select Destination", Default:="A1", Type:=8)
                rngSourceRange.Copy rngDestination
                rngDestination.CurrentRegion.EntireColumn.AutoFit
                wkbSourceBook.Close False
            End If
        End With
    End Sub

我做了一些编辑，但由于我并不真正了解 VBA，所以我有点卡住了。这就是我现在所处的位置。任何帮助将不胜感激！

     Private Sub CommandButton1_Click()
         Dim wkbCrntWorkBook As Workbook
         Dim wkbSourceBook As Workbook
         Dim rngSourceRange As Range
         Dim rngDestination As Range
         Set wkbCrntWorkBook = ActiveWorkbook
         With Application.FileDialog(msoFileDialogOpen)
             .Filters.Clear
             .Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
             .AllowMultiSelect = False
             .Show
             If .SelectedItems.Count > 0 Then
                 Workbooks.Open .SelectedItems(1)
                 Set wkbSourceBook = ActiveWorkbook
                 Set rngSourceRange = Range(A2:A500)
                 wkbCrntWorkBook.Activate
                 Set rngDestination = Range(A2)
                 rngSourceRange.Copy
                 rngDestination.PasteSpecial Paste:=xlPasteValues
                 rngDestination.CurrentRegion.EntireColumn.AutoFit
                 wkbSourceBook.Close False
             End If
         End With
     End Sub

范围的结尾不一定是 500，我只是想确保捕获现在和将来会在范围内的所有值。如果还有一种方法可以让宏只选择旁边列 (B) 中有数据的单元格，我很想听听一些建议！

谢谢！

【参考方案1】：

试试：

Sub test()

Dim wb1 As Workbook
Dim wb2 As Workbook

Set wb1 = Workbooks("Book1")
Set wb2 = Workbooks("Book2")

Dim LastRowS1CA As Long
Dim LastRowS2CA As Long

LastRowS1CA = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row

wb1.Sheets("Sheet1").Range("A1:A" & LastRowS1CA).Copy '<=== Copy Range from Workbook Book 1 sheet1

LastRowS2CA = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row

wb2.Sheets("Sheet1").Range("A" & LastRowS2CA).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False '<=== Paste range to workbook Book 2 sheet2

End Sub

【讨论】：

感谢您的快速响应。所以我只想将 A 行作为范围，它完全来自另一个工作簿。我会在第 4 行中更改什么内容以从另一个工作簿中提取吗？

它说工作簿超出了我的范围。我从来没有真正用过 VBA 编码，所以我可能会完全毁掉一个完美的代码

确保检查工作簿和工作表名称（根据需要更改）