简体   繁体   中英

copy-paste columns on excel VBA

Been trying to copy-paste columns on excel VBA for days, code doesn't work no matter what

Sub CopyRangeofCellsanotherone()
    Dim x As Workbook
    Dim y As Workbook
    Dim LastRow As Long
    Dim LastRowToCopy As Long

    Set x = Workbooks.Open("C:\trabalho da DELL\source.xlsx")
    Set y = Workbooks.Open("C:\trabalho da DELL\destination.xlsx")

    LastRowToCopy = x.Sheets("sourcesheet").Cells(x.Sheets("sourcesheet").Rows.Count, "A").End(xlUp).Row

    x.Sheets("sourcesheet").Range("A" & LastRowToCopy).Copy 'copy from A1 to lastrow

    LastRow = y.Sheets("destsheet").Cells(y.Sheets("destsheet").Rows.Count, "A").End(xlUp).Row 'find the last row

    y.Sheets("destsheet").Range("A" & LastRow).PasteSpecial 'paste on the lastrow of destination + 1 (so next empty row)

    x.Close

End Sub

I think the code is mostly self-explanatory (or atleast, what I intend it to do) but it's not working!! How can I copy contents from column A - source sheet , to column A - destination sheet? And how can I then apply that , to a set of columns? (from A to G for example). I have under 5 hours of VBA under my belt so this might look really simple to some of you... edit: forgot to mention it gives me run-time error 91 on LastRowToCopy line.

Try the code below.

Notes on what you have written:

Extend this to fully reference a range not just one cell

 sourceSheet.Range("A1:A" & sourceLastRow)

Add + 1 here to paste to the next available row

destSheet.Range("A" & destLastRow + 1)

Set up variables for the sheet themselves so code is more readable

Set sourceSheet = sourceBk.Sheets("sourcesheet")

Include more of a description with the lastRow variable so you know which workbook and worksheet is being referenced

sourceLastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row

And of course, have Option Explicit at the top to check your variable declarations.

Full code:

Option Explicit

Sub CopyRangeofCellsanotherone()

    Dim sourceBk As Workbook
    Dim destBK As Workbook
    Dim sourceLastRow As Long
    Dim destLastRow As Long
    Dim sourceSheet As Worksheet
    Dim destSheet As Worksheet

    Set sourceBk = Workbooks.Open("C:\trabalho da DELL\source.xlsx")
    Set destBK = Workbooks.Open("C:\trabalho da DELL\destination.xlsx")

    Set sourceSheet = sourceBk.Sheets("sourcesheet")
    Set destSheet = destBK.Sheets("destsheet")

    sourceLastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
    destLastRow = destSheet.Cells(destSheet.Rows.Count, "A").End(xlUp).Row 'find the last row

    sourceSheet.Range("A1:A" & sourceLastRow).Copy 'copy from A1 to lastrow

    destSheet.Range("A" & destLastRow + 1).PasteSpecial 'paste on the lastrow of destination + 1 (so next empty row)

    sourceBk.Close

End Sub

Extending the copy range:

There are a variety of ways to extend this to a range of columns (you will need to explain this further).

For example, if you know in advance the last column eg "C", you can amend the line for sourceSheet range as follows:

sourceSheet.Range("A1:C" & sourceLastRow)

If you don't know you can find the last column eg as per Ron De Bruin

 sourceLastCol =sourceSheet.Cells(1,sourceSheet.Columns.Count).End(xlToLeft).Column

Syntax for copying source range would then change to

sourceSheet.Range(sourceSheet.Cells(1, 1), sourceSheet.Cells(sourceLastRow, sourceLastCol)).Copy
Sub foo2()
Dim x As Workbook
Dim y As Workbook

Set x = Workbooks.Open("C:\trabalho da DELL\source.xlsx")
Set y = Workbooks.Open("C:\trabalho da DELL\destination.xlsx")

y.Sheets("destsheet").Range("A:A").Value = x.Sheets("sourcesheet").Range("A:A").Value

x.Close

End Sub

Check if the above code copies column A successfully.
If it does, then repeat the line
y.Sheets("destsheet").Range("A:A").Value = x.Sheets("sourcesheet").Range("A:A").Value
replacing Column A with other columns.

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