[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 390
  • Last Modified:

Tricky copy and paste macro - to copy data from multiple workbooks

Hi Experts

I have the following vba code which I would like to preform the following steps in sequence:-

1. Open up 1st workbook in specified file path as per code then copy the data from worksheet "cm" and paste the data into workbook master template (which is already open) into worksheet "cm1"...

2. Both worksheet in the two workbook are 100% the same...

3. In both worksheets the data that needs to be copied starts at row m18....all rows above are header info - only

4. Once the data has been copied from the first workbook - close workbook

5. Open second workbook and copy the data once again starting point row m18, worksheet "cm" to destination sheet "cm1"... But copy the data one row down - as we have previously copied data from the first workbook...

And so...

Hi Experts

I am getting a compile error "variable not defined" with the following vba code

On line  If strFilename <> wkDst.Name Then

The workbooks ate saved in excel 2007 as . Xlsm file....here is the link to the original question :-
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28003426.html

Sub Conso()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim strFilename As String

    Set wbDst = ThisWorkbook  ' Workbooks.Open("C:\Documents and Settings\Test\Master Template.xls")
   
    strFilename = Dir("C:\Documents and Settings\Test\*.xls")
   
     While strFilename <> ""
   
        If strFilename <> wkDst.Name Then
       
            Set wbSrc = Workbooks.Open("C:\Documents and Settings\Test\" & strFilename)

on error resume next        
wbSrc.Worksheets("cm").UsedRange.Copy wbDst.Worksheets("cm1").Range("A" & wbDst.Rows.Count).End(xlUp).Offset(1)
                 
on error goto 0
           
             wbSrc.Close
        End If
       
        strFilename = Dir()
       
    Wend
                 
End Sub
0
route217
Asked:
route217
  • 10
  • 9
2 Solutions
 
SteveCommented:
firstly... need to change the following line:

If strFilename <> wkDst.Name Then

Open in new window

to
If strFilename <> wbDst.Name Then

Open in new window


do you only copy one line at a time?
Are there a start and end column?

the issue seems to be with the copy line:
wbSrc.Worksheets("cm").UsedRange.Copy wbDst.Worksheets("cm1").Range("A" & wbDst.Rows.Count).End(xlUp).Offset(1)

Open in new window


you may need something like this for a single row:

Dim wsSrc as Worksheet: Set wsSrc = wbSrc.Worksheets("cm") 
Dim wsDest as Worksheet: Set wsDest = wbDst.Worksheets("cm1") 
Dim destrow as long: destrow = wsDest.Cells(Rows.Count, 1).End(xlUp).row + 1

wsSrc.Range(wsSrc.Range("A18"),wsSrc.Range("M18")).Copy _
wsDest.Range("A"& destrow &":M"& destrow)

Open in new window

0
 
NorieCommented:
Change wkDst to wbDst on the line causing the error.

  If strFilename <> wbDst.Name Then

Open in new window

That will fix the error.

I think the code needs updated to copy the correct range.

You say the data starts in M18, where does it go down/across to.

Also where should it be copied to, column A?
0
 
route217Author Commented:
Apologies error firm last question - I corrected that part...

Assume first worksheet "cm", then copy from m18:ar27...paste into madter workbook close WBk
Open next WBk copy from m18:ar22....paste data in to master workbook at m28 next blank row...close work book

Etc.... Open third workbook and repeat
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
route217Author Commented:
So the starting point on worksheet cm is always m18: on all the workbooks you open and copy across to the master workbook...
0
 
NorieCommented:
Try this.
Option Explicit

Sub Conso()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim wsDst As Worksheet
Dim strFilename As String

    Set wbDst = ThisWorkbook  ' Workbooks.Open("C:\Documents and Settings\Test\Master Template.xls")
    
    Set wsDst = wbDst.Worksheets("cm1")
    strFilename = Dir("C:\Documents and Settings\Test\*.xls")
    
     While strFilename <> ""
    
        If strFilename <> wbDst.Name Then
        
            Set wbSrc = Workbooks.Open("C:\Documents and Settings\Test\" & strFilename)
            
            Set wsSrc = wbSrc.Worksheets("cm")
            
            With wsSrc
                .Range("M18", .Range("M" & .Rows.Count).End(xlUp).Offset(0, 31)).Copy wsDst.Range("A" & Rows.Count).End(xlUp).Offset(1)
            End With
            
             wbSrc.Close
        End If
        
        strFilename = Dir()
        
    Wend
                 
End Sub

Open in new window

0
 
route217Author Commented:
Imnorie just a point I might have missed... When pasting into master worksheet/book we are starting at row m18...
0
 
NorieCommented:
Here's the code adjusted to copy to M18.
Option Explicit

Sub Conso()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim wsDst As Worksheet
Dim rngDst As Range
Dim strFilename As String
Dim strPath As String

    strPath = "C:\Documents and Settings\Test\"
    
    Set wbDst = ThisWorkbook  ' Workbooks.Open("C:\Documents and Settings\Test\Master Template.xls")

    Set wsDst = wbDst.Worksheets("cm1")

    Set rngDst = wsDst.Range("M18")

    strFilename = Dir(strPath & "*.xls")

    While strFilename <> ""

        If strFilename <> wbDst.Name Then

            Set wbSrc = Workbooks.Open(strPath & strFilename)

            Set wsSrc = wbSrc.Worksheets("cm")

            With wsSrc
                .Range("M18", .Range("M" & .Rows.Count).End(xlUp).Offset(0, 31)).Copy rngDst
            End With

            Set rngDst = wsDst.Range("M" & Rows.Count).End(xlUp).Offset(1)

            wbSrc.Close
        End If

        strFilename = Dir()

    Wend

End Sub

Open in new window

0
 
route217Author Commented:
Imnorie I am getting a error on line 20 as above

Run time error 9

Subscript out of range
0
 
NorieCommented:
Definitely line 20?

I can't reproduce that, even if I use a path that doesn't exist.

Did you change anything?
0
 
route217Author Commented:
Ok new code...line 27

Set wsDst = wbDst.worksheets("cm1")
0
 
NorieCommented:
Line 27 is blank.

This code is on line 16.
Set wsDst = wbDst.Worksheets("cm1")

Open in new window

It sets  a reference to the destination worksheet 'cm1' in the destination workbook.

The destination workbook is referenced here.
Set wbDst = ThisWorkbook

Open in new window


Is there definitely a worksheet with the name 'cm1'  in the workbook the code is in?
0
 
route217Author Commented:
Yep...solved that part...

The code works - just one small correction... When the macro copy's the data from stc to DSt file worksheet cm to cm1 it insert the data one row after m18 if m18 is our starting point....
0
 
NorieCommented:
Do you mean the first set of copied data is pasted at M19?

I can't see why that would happen, the destination for the data from the first workbook is harcoded as M18.

Have you checked the files being copied from?

Perhaps there's a blank row somewhere.
0
 
route217Author Commented:
Yep to first question....I believe u...hard coded m18...
0
 
NorieCommented:
Yes M18 is hardcoded, so the data is being copied to M18, not M19.

The only way I can reproduce the problem is to put a blank line in row 18 of the first source file.

Then it appears as if the data has been copied to M19.
0
 
route217Author Commented:
CAn we put in a step to delete row m17 as it pastes to m18 when I have m17 as starting point, then close workbooks...
0
 
NorieCommented:
Sorry I don't understand.

What exactly are you copying from these files?

Are there any blank rows in any of them?

Why delete M17 when you could fix the problem without changing the starting point by deleting M18 if it's blank?
0
 
route217Author Commented:
No blank rows on the files all files have data...

I was suggesting to delete the first blank row after row m16...which is the header row..
0
 
NorieCommented:
I thought the problem was the data was being paste into M19 rather than requested M18, leaving M18 blank.

Anyway if you want to delete M17:AR17 you can use this.
wsDst.Range("M17:AR17").Delete xlShiftUp

Open in new window


If you wanted to delete M18:AR18:
wsDst.Range("M18:AR18").Delete xlShiftUp

Open in new window


To delete both M17:AR17 and M18:AR18:
wsDst.Range("M17:AR18).Delete xlShiftUp

Open in new window

Whichever you use it should go right at the end of the code between Wend and End Sub.
0
 
route217Author Commented:
Hi imnorie

Can you assist on the following as you did the original macro...
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28024975.html
0

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

  • 10
  • 9
Tackle projects and never again get stuck behind a technical roadblock.
Join Now