将单元格从打开的工作簿复制到另一个

Posted 2023-02-24

【中文标题】将单元格从打开的工作簿复制到另一个

【英文标题】：Copy cells from open workbook into another

【发布时间】：2018-08-22 15:53:34

【问题描述】：

在我的第一个活动工作簿中，A 列有一个数字列表，从单元格 A1 开始，每次都列出不同数量的行。

我想将所有包含信息的 A 列单元格复制到另一个工作簿中（如果在此过程中第二个工作簿可以保持关闭，那将是更可取的）。

我希望在第二个工作簿中的粘贴位置是第一个可用空行中的 A 列。即我希望这第二个工作簿是第一个工作簿的所有数据列 A 的列表。

【问题讨论】：

欢迎来到 *** - 这实际上是一个非常常见的问题，所以我建议您在 google 上搜索一下以找到您要查找的内容。这是一个开始rondebruin.nl/win/s9/win005.htm

【参考方案1】：

将此代码粘贴到具有源数据的工作簿的 VBA 编辑器中的新模块中（打开 VBA 编辑器：ALT+F11）并运行宏“CopyToAnotherWorkbook”。

运行前，指定目标工作簿路径，提示在代码中。

Sub CopyToAnotherWorkbook()

Application.ScreenUpdating = False

Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.ActiveSheet
Dim LastRow_wb%: LastRow_wb = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim arr() As Variant
ReDim arr(0 To LastRow_wb - 1)

For i = 1 To LastRow_wb
    arr(i - 1) = ws.Cells(i, 1)
Next i

Dim wb2 As Workbook: Set wb2 = Workbooks.Open("C:\Book2.xlsx") ' <- Paste your Link to the Workbook here!

Dim ws2 As Worksheet: Set ws2 = wb2.Sheets(1)
Dim LastRow_wb2%: LastRow_wb2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1

If LastRow_wb2 = 2 Then
    LastRow_wb2 = 1
End If

ws2.Range("A" & LastRow_wb2 & ":A" & LastRow_wb2 + UBound(arr)).Value = WorksheetFunction.Transpose(arr)

Application.ScreenUpdating = True
wb2.Close True
Set ws2 = Nothing
Set wb2 = Nothing
Set ws = Nothing
Set wb = Nothing

End Sub

【讨论】：

Smartini 真的很不错！非常感谢您的帮助！还有一件额外的事情，每次复制单元格的数据都会发生变化，即我无法将宏保存在那里，如果我将它保存在个人宏工作簿中，有没有办法将第一个工作簿设置为来自哪个工作簿宏已经运行了吗？

我不太明白你的问题。您可以将此代码添加到您在 Excel 中的个人工作簿中，每次启动 Excel 后会自动打开（隐藏） - 您的意思是，对吗？ VBA 代码将复制活动表中的所有日期。您可以打开您拥有的任何源 Excel，在后台也打开个人 xlsb，您可以切换到源 Excel，运行宏，所有内容都将复制到编写代码的 Excel 工作簿中。如果您不想固定目标，也可以添加“FilePicker”。