VBA Copy and Paste from one workbook to another, append to last column

Joined
May 25, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Hello! I'm new to the forums and I am new to VBA.

I have a set of reports that run every week and are sorted into specific files with specific names. The data in these reports is always formatted the same.

What I need my code to do is, open a workbook, copy the column (under the header, B2 and below), and paste it into a master workbook that archives all this data in their own respective sheets. That data column would be pasted at the first open column space under a new header starting in row 3. So, if C3 was the first spot open it would paste there, if D3 was open it would paste there, then E3, etc.

I have gathered and pieced together code that does roughly what I want, but I need help.

This code grabs the data from the correct place and puts it in the correct sheet, the only issue is that it places the code at the bottom of the first row instead of the next open column.

VBA Code:
Code:
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
   
    Workbooks.Open "M:\Engineering personnel\Brussel_Sproutington\Automated 6Pack\15Labor hours for PMs per craft\Labor hours for PMs per Craft Current.xls"  'Open Spreadsheet

    Set wsCopy = Workbooks("Labor hours for PMs per Craft Current.xls").Worksheets(1)
    Set wsDest = Workbooks("6Pack MasterSheet Copy.xlsm").Worksheets("Auto Graph 15 LHfPM")
    
    lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row

    lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row

    wsCopy.Range("A2:B" & lCopyLastRow).Copy _
    wsDest.Range("A" & lDestLastRow)


    Workbooks("Labor hours for PMs per Craft Current.xls").Close SaveChanges:=True 'Close Spreadsheet


Could someone help me alter this so that it places the data properly?

Thank you!
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
The statement
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
is looking for next empty row instead of the next empty column

For next empty column
lDestLastCol = wsDest.Cells(1,wsDest.Columns.Count).End(xlToLeft).Offset(1).Column

Then with minor adjustment to your code, it should be fine

It is much easier to set the Copy workbook when opening it without have to define the location first. Here is how I would write the code. I have not tested it but I believe you can understand it easily.
VBA Code:
Sub Alt()

Dim wbDest As Workbook
Dim wbCopy As Workbook
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim rngCopy As Range
Dim lDestLastCol As Long
  
    Set wbDest = ActiveWorkbook
    Set wsDest = wbDest.Sheets("Auto Graph 15 LHfPM")
  
   ' Search destination Workbook
    Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb), *.xls; *.xlsx; *.xlsm; *.xlsb", Title:="Select a File")
    If Fname = False Then Exit Sub                         'CANCEL is clicked

    Set wbCopy = Workbooks.Open(Filename:=Fname, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
    Set wsCopy = wbCopy.Sheets("Sheet1")
    Set rngCopy = wsCopy.Range("A2", wsCopy.Cells(wsCopy.Rows.Count, "B").End(xlUp))
   
    'Find next empty column in wsDest
    lDestLastCol = wsDest.Cells(1, wsDest.Columns.Count).End(xlToLeft).Offset(0, 1).Column
    rngCopy.Copy wsDest.Cells(1, lDestLastCol)
    wbDest.Close SaveChanges:=True 'Close Spreadsheet

End Sub
 
Upvote 0
Solution
That got me closer to my goal, thanks!

Now the code pastes in the end column, but that's not exactly what I'm looking for. Here's an example of where the data should paste
Craft5/17/20215/24/20215/31/20216/7/2021
Mechanic1115
HVAC1718
Electrical1913

The VBA code should paste data into that column under 5/31/2021, then the next time it pastes it should go into 6/7/2021 and so on and so forth.

I didn't really understand the changes to defining locations and couldn't really get that to work, but here's my code now

VBA Code:
Dim wbDest As Workbook
Dim wbCopy As Workbook
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim rngCopy As Range
Dim lDestLastCol As Long
 
    Set wbDest = ActiveWorkbook
    Set wsDest = wbDest.Sheets("Auto Graph 1 LPMbC")
 
   ' Search destination Workbook
    Workbooks.Open "M:\Engineering personnel\Brussel_Sproutington\Automated 6Pack\15Labor hours for PMs per craft\Labor hours for PMs per Craft Current.xls"

    Set wsCopy = Workbooks("Late PMs by Craft Current.xls").Worksheets(1)
    Set rngCopy = wsCopy.Range("B2", wsCopy.Cells(wsCopy.Rows.Count, "B").End(xlUp))
  
    'Find next empty column in wsDest
    lDestLastCol = wsDest.Cells(1, wsDest.Columns.Count).End(xlToLeft).Offset(0, 1).Column
    rngCopy.Copy wsDest.Cells(1, lDestLastCol)

    Workbooks("Labor hours for PMs per Craft Current.xls").Close SaveChanges:=True 'Close Spreadsheet
 
Upvote 0
I figured it out! Your code does indeed work, I just have to adjust the values in this line of code to 3's

lDestLastCol = wsDest.Cells(3, wsDest.Columns.Count).End(xlToLeft).Offset(0, 1).Column
rngCopy.Copy wsDest.Cells(3, lDestLastCol)

Or for anyone reading this, with the table I showed above those would be 2s instead. Thank you again!
 
Upvote 0
I figured it out! Your code does indeed work, I just have to adjust the values in this line of code to 3's

lDestLastCol = wsDest.Cells(3, wsDest.Columns.Count).End(xlToLeft).Offset(0, 1).Column
rngCopy.Copy wsDest.Cells(3, lDestLastCol)

Or for anyone reading this, with the table I showed above those would be 2s instead. Thank you again!
Glad you have it figured out. I guess I was still sleeping on my bed during that time ?
 
Upvote 0

Forum statistics

Threads
1,213,533
Messages
6,114,179
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top