Help with VBA code to copy and paste to next open column

VSM

New member
Joined
Feb 13, 2018
Messages
19
Reaction score
0
Points
0
Excel Version(s)
O365
Hello,

I have been using the VBA below for copying and pasting a range into the next open row of data. I am wanting to modify this code to paste the data into the next open column instead of the next open row below. Any help would be greatly appreciated!

Code:
Sub Copy_Paste_Below_Last_Cell()
'Find the last used row in both sheets and copy and paste data below existing data.


Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastCol As Long
Dim lDestLastCol As Long


  'Set variables for copy and destination sheets
  Set wsCopy = Workbooks("Production Summary Shrink Report Aug 23 2021.xlsm").Worksheets("FNDWRR")
  Set wsDest = Workbooks("Production Summary Shrink Report Aug 23 2021.xlsm").Worksheets("Sheet1")
    
  '1. Find last used row in the copy range based on data in column A
  lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
    
  '2. Find first blank row in the destination range based on data in column A
  'Offset property moves down 1 row
  lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row


  '3. Copy & Paste Data
  wsCopy.Range("A2:D" & lCopyLastRow).Copy _
    wsDest.Range("A" & lDestLastRow)
    
End Sub
 
Change this
Code:
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
to this
Code:
lDestLastColumn = wsDest.Cells.Find("*", , , , xlByColumns, xlPrevious).Column
and this
Code:
wsDest.Range("A" & lDestLastRow)
to this
Code:
wsDest.Cells(1, lDestLastColumn + 1)
 
Hello, thank you for your reply! When I made the changes to the code I got an error: "Object Variable or With block variable not set".
Can you please tell me what I am missing? I have pasted the updated code below:

Code:
Sub Copy_Paste_Below_Last_Cell()
'Find the last used row in both sheets and copy and paste data below existing data.


Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastCol As Long


  'Set variables for copy and destination sheets
  Set wsCopy = Workbooks("Production Summary Shrink Report Aug 23 2021.xlsm").Worksheets("FNDWRR")
  Set wsDest = Workbooks("Production Summary Shrink Report Aug 23 2021.xlsm").Worksheets("Sheet1")
    
  '1. Find last used row in the copy range based on data in column A
  lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
    
  '2. Find first blank row in the destination range based on data in column A
  'Offset property moves down 1 row
  lDestLastCol = wsDest.Cells.Find("*", , , , xlByColumns, xlPrevious).Column


  '3. Copy & Paste Data
  wsCopy.Range("A2:D" & lCopyLastRow).Copy _
    wsDest.Cells(1, lDestLastCol + 1)
    
End Sub
 
Tried this on a temp workbook and it works as advertised!
Code:
Sub This_Works_Here()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastCol As Long
Set wsCopy = Workbooks("Some_Workbook_Name.xlsm").Worksheets("Sheet1")    '<----- Change wb name and sheet name
Set wsDest = Workbooks("Some_Workbook_Name.xlsm").Worksheets("Sheet2")    '<----- Change wb name and sheet name
lCopyLastRow = wsCopy.Cells(Rows.Count, "A").End(xlUp).Row
lDestLastCol = wsDest.Cells.Find("*", , , , xlByColumns, xlPrevious).Column
    wsCopy.Range("A1:D" & lCopyLastRow).Copy wsDest.Cells(1, lDestLastCol + 1)    '<----- Change range reference if required
End Sub
 
My preference is
Code:
wsDest.Cells(1, lDestLastCol + 1).Resize(lCopyLastRow, 4).Value = wsCopy.Cells(1, 1).Resize(lCopyLastRow, 4).Value
instead of this
Code:
wsCopy.Range("A1:D" & lCopyLastRow).Copy wsDest.Cells(1, lDestLastCol + 1)
Just for the simple fact that I try to minimize using Copy & Paste, just like not using selecting.
Strictly a personal quirk but in the right circumstance it should be quicker.
 
Back
Top