简体   繁体   中英

Copy cells from open workbook into another

In my first active workbook, column A has a list of numbers, starting in cell A1, and listing down a varied number of rows each time.

I would like to copy all of the column A cells containing information into another workbook (if the second workbook could remain closed during the process that would be preferable).

My desired paste location in the second workbook would be column A in the first empty row available. ie I want this second workbook to be a list of all of the data column A of the first workbook has ever had.

Paste this Code into a new Module in the VBA Editor of the Workbook which has the Source Data (Open VBA Editor: ALT+F11) and run the Macro "CopyToAnotherWorkbook".

before running, specify the Destination Workbook Path, hint is in the code.

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM