Copying a range from multiple sheets and inserting into multiple sheets in another workbook.

N

Nurzhan

Board Regular
Joined
Dec 13, 2017
Messages
60
Hallo,
I have 2 workbooks. A and B. A = source, B = Target. Each of them has sheets with the same names. The task is to copy a certain range from A and insert it in a cell below the last occupied one. My code is as follows but it fails to work and I couldn't troubleshoot. could you pls help.

Error appears at
Code: 
lastRow = WBb.Sheets(sh.Name).Cells(Rows.Count, "B").End(xlUp).row+1
. Error = "91", saying object variable or with block variable no set.

Code: 
Sub FromA2B()    
    Dim WBa As Workbook
    Dim WBb As Workbook
    Dim sh As Worksheet
    Dim lastRow As Range
    
    Set WBa = ThisWorkbook
    Set WBb = Workbooks("SWDP June 2010 - May 2017 (Oil and WI wells).xlsx")
    
    For Each sh In WBa.Worksheets
        sh.Range("B9:Z39").Copy
        lastRow = WBb.Sheets(sh.Name).Cells(Rows.Count, "B").End(xlUp).row+1
        lastRow.Select
        Selection.Insert Shift:=xlDown
        Application.CutCopyMode = False
    Next sh
End Sub
 
Last edited:

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Sort by date Sort by votes
Try
Code: 
Sub FromA2B()
    Dim WBa As Workbook
    Dim WBb As Workbook
    Dim sh As Worksheet
    
    Set WBa = ThisWorkbook
    Set WBb = Workbooks("SWDP June 2010 - May 2017 (Oil and WI wells).xlsx")
    
    For Each sh In WBa.Worksheets
        sh.Range("B9:Z39").Copy WBb.Sheets(sh.Name).Cells(Rows.Count, "B").End(xlUp).Offset(1)
    Next sh
End Sub
 
Upvote 0
How about if there 3 workbooks with source data (with identical headers) going to the target, and you wanted to only bring over the headers once but the data from all three? ;)
 
Upvote 0
@WWII_Buff
Please do not "hijack" other peoples threads with your own questions.
 
Upvote 0
Thanks, it works fine. But I wanted to "insert" because at the end of the destination sheet table there formulas and I want to insert between those rows.
So I want the new data to be inserted between rows 2596 and 2597 so that those formulas catch new data as well.
 
Last edited:
Upvote 0
Ok...I could change it to have those rows inserted. Also added code to delete certain columns. But now I wanna make the range to be copied dynamic (number of days in a month) but what I wrote doesn't work. VBA just doesn't copy anything. What could be the problem?
Code: 
Sub FromA2B()    Dim WBa As Workbook
    Dim WBb As Workbook
    Dim sh As Worksheet
    Dim lastRow As Integer
        
    On Error Resume Next
    Set WBa = ThisWorkbook
    Set WBb = Workbooks("SWDP June 2010 - May 2017 (Oil and WI wells).xlsx") 
    lastRow = Cells(Rows.Count, "B").End(xlUp).Row
    
    For Each sh In WBa.Worksheets
        sh.Range("K:L,R:S").Delete Shift:=xlToLeft 
        sh.Cells(lastRow, 26).Copy 
        WBb.Sheets(sh.Name).Cells(Rows.Count, "B").End(xlUp).Offset(1).Insert Shift:=xlShiftDown 
    Next sh
End Sub
 
Last edited:
Upvote 0
Guys, so I've come up with this code but now another trouble appeared. it's working with 1st sheet only. what could be the problem?
Code: 
Sub FromA2B_1()    Dim WBa As Workbook
    Dim WBb As Workbook
    Dim sh As Worksheet
    Dim lastRow As Long
    Dim startCell As Range
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
        
    On Error Resume Next
    Set WBa = ThisWorkbook
    Set WBb = Workbooks("SWDP June 2010 - May 2017 (Oil and WI wells).xlsx")
    Set startCell = Range("B9")
    
    lastRow = Cells(Rows.Count, "B").End(xlUp).Row
    
    For Each sh In WBa.Worksheets
        Range("K:L,R:S").Delete Shift:=xlToLeft
        Range(startCell, sh.Cells(lastRow, 26)).Copy
        WBb.Sheets(sh.Name).Cells(Rows.Count, "B").End(xlUp).Offset(1).Insert Shift:=xlShiftDown
    Next sh
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    
End Sub
 
Upvote 0
Try
Code: 
    Set WBa = ThisWorkbook
    Set WBb = Workbooks("SWDP June 2010 - May 2017 (Oil and WI wells).xlsx")
    
    For Each sh In WBa.Worksheets
      lastRow = sh.Cells(Rows.Count, "B").End(xlUp).Row
      sh.Range("K:L,R:S").Delete shift:=xlToLeft
      sh.Range("B9:Z" & lastRow).Copy
      WBb.Sheets(sh.Name).Cells(Rows.Count, "B").End(xlUp).Offset(1).Insert shift:=xlShiftDown
    Next sh
& remove this line
Code: 
On Error Resume Next
That is the worst thing you can do. All it does is mask any errors, it does not cure them.
 
Upvote 0
Now works better. Can I use
Code: 
On Error Resume Next
if sheet names in both workbooks are not the same? I mean if source WB contains sheets which are not in the destination WB.
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
VBA copy paste cell range below first blank row from one wb to another
Replies
9
Views
91
Joe4
Joe4
E
  • Solved
Copying data from 1 sheet to another in vba
Replies
7
Views
185
Kaper
Kaper
C
  • Question
Copy and paste data through multiple workbooks
Replies
2
Views
200
CDaviess
C
D
  • Locked
  • Question
Range in worksheet1 Insert into worksheet2 from row 2
Replies
1
Views
162
Fluff
Fluff
J
  • Question
Macro to copy values from multiple sheets in a workbook to a new worksheet in the same workbook
Replies
3
Views
186
MARK858
MARK858

Forum statistics

Threads
1,214,915
Messages
6,122,212
Members
449,074
Latest member
cancansova

Share this page

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