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

[Brussel_Sproutington]

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.

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!

 

[Zot]

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.

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

 

[Brussel_Sproutington]

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

Craft	5/17/2021	5/24/2021	5/31/2021	6/7/2021
Mechanic	11	15
HVAC	17	18
Electrical	19	13

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

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

 

[Brussel_Sproutington]

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!

 

[Zot]

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 ?