VBA copying multiple sheets to multiple sheets

[Jumparound]

Hi,

I have been wrestling with this for a while trying a number of bits of code I have found online but can't find anything that matches what I want to do or can change enough to make it work for me.

I have workbooks of data in a folder and I want to copy a range of data from each one into different worksheets of a master sheet in the same folder. The files to copy from are labelled as follows:
TS Weekly Report - SiteA Jan
TS Weekly Report - SiteB Jan
TS Weekly Report - SiteC Jan
TS Weekly Report - SiteD Jan
TS Weekly Report - SiteE Jan

The file to copy to is:
TS Weekly Report - UK Jan

All these workbooks are in C:\Users\User\Desktop\Test

All the files to be copied from have a worksheet called Site Summary and the data to be copied in all these is in C9:D27
I would like to paste these data into the same place in a worksheet for each site in the UK Jan workbook. So it would open SiteA workbook copy the data from C9:D27 in Site Summary and paste into the UK Jan workbook in worksheet SiteA in cells C9:D27. Then open SiteB workbook copy the data from C9:D27 in Site Summary and paste into the UK Jan workbook in worksheet SiteB in cells C9:D27 and so on.....

Can anyone help with this?

 

[mumps]

Are the "Site" workbooks the only files in the folder?

 

[Jumparound]

Sorry for the delay! Yes they are

 

[mumps]

Place this macro in a regular module in the "TS Weekly Report - UK Jan" workbook and run it from there. The macro assumes that all the "Site" worksheets already exist. It also assumes that all the source files have an "xlsx" extension.

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim shName As String
    Const strPath As String = "C:\Users\User\Desktop\Test\"
    strExtension = Dir("*.xlsx")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            shName = Mid(wkbSource.Name, 20, 5)
            .Sheets("Site Summary").Range("C9:D27").Copy wkbDest.Sheets(shName).Range("C9")
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[Jumparound]

Thanks although this doesn't seem to do anything. I've put the code in a new module and ran it (just changed the file path) and nothing seems to happen. I don't get any errors or pop ups and it only seems to be doing something for a fraction of a second before finishing. Any ideas what might be wrong?

Thanks

 

[mumps]

I can't be sure of the problem. I tried the macro on some dummy files and it worked as you requested. The only thing I can think of is that the file names might not be a match. I assumed that all the source files exactly follow this format: TS Weekly Report - SiteA Jan ... this means that "SiteA" would start at the 20th character in the name string for all the source files. Also, the file extension should be "xlsx". The other thing you should check is that the folder path in the code is correct. If all these things are OK, perhaps you could upload copies of 2 or 3 sample source files and a copy of your destination file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark each file for 'Sharing' and you will be given a link to each file that you can post here. If the workbooks contains confidential information, you could replace it with generic data.

 

[Jumparound]

Hi,

The files uploaded below. I kept the file path as above as it contains my name. I just change the "user" part of the file path to my name (copied from the file path in file explorer)
https://www.dropbox.com/s/dgmp0ksu2o1xv1w/TS Weekly Report - SiteA Jan.xlsx?dl=0
https://www.dropbox.com/s/n0m4tna8bhnytqh/TS Weekly Report - SiteB Jan.xlsx?dl=0
https://www.dropbox.com/s/gw5mr6v0hjo3s0u/TS Weekly Report - UK Jan.xlsm?dl=0

Thanks for your help

 

[Fluff]

Try changing this line as shown

strExtension = Dir([COLOR=#ff0000]strPath & [/COLOR]"*.xlsx")

 

[mumps]

I just tried the macro as written and it worked properly. Could I suggest that you try it again. This time instead of running the whole macro, step through the macro one line at a time. You can do this by going to the module that contains the macro. Place the cursor anywhere in the macro code and press the F8 key. You will see that the first line in the code is highlighted in yellow. Each time you press the F8 key the next line will be highlighted. When you get to this line of code:

Set wkbSource = Workbooks.Open(strPath & strExtension)

and press the key, you should see your first Site file opens up and it is listed in the left hand panel. Does your first Site file open up? You can click 'Run' in the top menu and then click 'Reset' to terminate the macro.

 

[Jumparound]

Try changing this line as shown

strExtension = Dir([COLOR=#ff0000]strPath & [/COLOR]"*.xlsx")

This fixed it thank you!

I just tried the macro as written and it worked properly. Could I suggest that you try it again. This time instead of running the whole macro, step through the macro one line at a time. You can do this by going to the module that contains the macro. Place the cursor anywhere in the macro code and press the F8 key. You will see that the first line in the code is highlighted in yellow. Each time you press the F8 key the next line will be highlighted. When you get to this line of code:

Set wkbSource = Workbooks.Open(strPath & strExtension)

and press the key, you should see your first Site file opens up and it is listed in the left hand panel. Does your first Site file open up? You can click 'Run' in the top menu and then click 'Reset' to terminate the macro.

When I did this before making the change suggested by Fluff above it skipped over the Set wkbSource line entierly and went straight to the end to turn on screen updating. Strange, but fixed now! Thank you so much for your help and code!