VBA to copy paste data with multiple workbooks

Tosborn

New Member
Joined
May 24, 2016
Messages
44
G'day all groovy excellers,

I'm using a bit of VBA code I found on this site from a post that first appeared awhile back.

The code basically copy pastes data from an unopen workbook into the workbook that I have open.

Originally the code was just made for 1 closed workbook to copy from but I have managed to make it to go from 2 closed workbooks with data on different sheets to go to 1 open workbook with 2 corresponding sheets:

Code:
Sub BRexpGetData()

Dim mydata As String
'data location & range to copy
mydata = "='e:\[finance.xlsm]finance'!$d$7:$e$20" 

'link to worksheet
With ThisWorkbook.Worksheets("finance").Range("d7:e20") 
.Formula = mydata
'convert formula to text
.Value = .Value

End With


'for treasury turn

'data location & range to copy
mydata = "='e:\[treasury.xlsm]treasury'!$d$7:$e$30" 

'link to worksheet
With ThisWorkbook.Worksheets("treasury").Range("d7:e20") 
.Formula = mydata
'convert formula to text
.Value = .Value

End With
End Sub

By the way I should mention that I'm a total VBA dunce so if the code is clumsy (because I changed it) then I am not surprised :p. But it works a treat so far.

Ok, so from here I need to repeat this code about 30 times to make way for all of these worksheets that I will be receiving on a monthly basis.

Is there anyway of using a cell reference such as "A2" (when A2 = treasury) that could supplement typing out all of the different sheet names & workbooks as you can see in the above code.

So cells A1:A30 would have a list of all of the cost centres that I will be working with. It would go something like this:

A1 = finance
A2 = treasury
A3 = marketing

and so on.

Ideally this list could change in length and order from month to month and if the list only went from A1:A20 one month then the macro would be robust against errors for absent workbooks.

Please let me know if this is not completely clear.

Hope this isn't too much. Every time I post something on here I'm blown away by the skills and knowledge shown in the response so I though I'd take it next level this time ;).

Cheers,
Tim
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
You could use a loop and then assign different workbook/sheet names to variables.
I'd research the CASE statement in Excel which will show you how to alter variables based on the number of loop and then build the workbook and sheet names from those.
 
Upvote 0
I replied to a similar request 2 days ago, you can use that code to do what you need, if you need help I can modify it for you : http://www.mrexcel.com/forum/excel-...tions-match-workbook-name-worksheet-name.html


Hi Netuser,

Wow, that's great! Can't believe this guy has almost exactly the same issue as me! Even the same amount of workbooks too! hahhaaa

I tried to alter the code myself from the post but couldn't get it to work.

Yes, if you could please help me to change it would be great.

The main difference being is that I need to get data from a specific sheet in a workbook of the same name.

So to explain in detail:

Main workbook name could be "branch expenses.xlsm" It contains many tabs. I need to copy into the tabs, "finance", "treasury", "marketing" etc.

The workbooks that have the data are called "finance", "treasury", "marketing" etc and contain sheets of the same name that, respectively, contain the data therein.

For example the "finance.xlsm" file contains data in the "finance" sheet from range "d7:e20" that needs to paste into the "branch expenses.xlsm" workbook into the "finance" tab to range "d7:e20".

Hope it all makes sense, let me know if you need anything further :)

Going to wow everyone at work with this :D

Cheers,
Tim
 
Upvote 0
That is not an issue, I will adopt the code for your situation, but it doesn't require much alteration :) Just tell me are we copying whole sheet data or just d7:e20 from each sheet ? Just let me know the criteria to select data to copy.
 
Upvote 0
Here you go, change path and your workbook name as indicated in comments


Code:
Sub CopytoSheet()
'
' Copy same name workbook in worksheet
'

    Dim PathOfWorkbboks
    Dim objFolder As Object
    Dim objFile As Object
    Dim Main
    Dim ShtName, objName
    
Main = "branch expenses.xlsm" 'Change name of your main workbook here
         
Windows(Main).Activate
PathOfWorkbboks = "C:\Temp\"  ' Change to the path where all workbooks are
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(PathOfWorkbboks)
 
    For x = 1 To Sheets.Count
        With Sheets(x)
        Sheets(x).Activate
        ShtName = Sheets(x).Name
            For Each objFile In objFolder.Files
            objName = objFSO.Getfilename(objFile.path)
            If objName = ShtName & ".xlsm" Then
               Workbooks.Open objFile
               Sheets(ShtName).Select
               ActiveSheet.Range("D7:E20").Copy Destination:=Workbooks(Main).Sheets(ShtName).Range("D7")
               Application.CutCopyMode = False
               Workbooks(objName).Close savechanges:=False
            End If
            Next
        End With
    Next x

End Sub
 
Upvote 0
This is really awesome thanks. Been testing and so far so good.

Just one little thing. With each worksheet I import excel comes up with the msg:

"The name 'GL' already exists. Click Yes to use that version of the name, or click No to rename the version of 'GL' you're moving or copying."

I assume that because each sheet data that I import refers to a name range on another sheet called 'GL'. Excel is trying to copy this list along with the data and hence the info box.

It's not that bad but if I'm importing 30 different sheets this could get annoying.

I could potentially not use the name range but it's going to reduce the functionality of my spreadsheet that I send out.

Any ideas on how to hack?

Thanks again,
Tim
 
Upvote 0
I tried to test it but I am not getting any popup with named ranges. What we can do is that we can just copy the values. so it wont get anything else from source sheet. (But this will just get data and no formatting if you wanted to have the same formatting)

Here is just for values :

Code:
Sub CopytoSheet()
'
' Copy same name workbook in worksheet
'

    Dim PathOfWorkbboks
    Dim objFolder As Object
    Dim objFile As Object
    Dim Main
    Dim ShtName, objName
    
Main = "branch expenses.xlsm" 'Change name of your main workbook here
         
Windows(Main).Activate
PathOfWorkbboks = "C:\Temp\"  ' Change to the path where all workbooks are
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(PathOfWorkbboks)
 
    For x = 1 To Sheets.Count
        With Sheets(x)
        Sheets(x).Activate
        ShtName = Sheets(x).Name
            For Each objFile In objFolder.Files
            objName = objFSO.Getfilename(objFile.path)
            If objName = ShtName & ".xlsm" Then
               Workbooks.Open objFile
               Sheets(ShtName).Select
               ActiveSheet.Range("D7:E20").Copy
               Workbooks(Main).Sheets(ShtName).Range("D7").PasteSpecial Paste:=xlPasteValues
'               ActiveSheet.Range("D7:E20").Copy Destination:=Workbooks(Main).Sheets(ShtName).Range("D7")
               Application.CutCopyMode = False
               Workbooks(objName).Close savechanges:=False
            End If
            Next
        End With
    Next x

End Sub
 
Upvote 0
Hey Netuser,

This is great, did testing on 3 workbooks this afternoon and is moving on like a dream. Was driving me nuts at first as I assigned a shortcut key to the macro and it wouldn't work properly?!

After awhile I worked out that it worked fine if i hit run in the macro developer menu, Weird!!!!

Anyhoo, that doesn't really matter, I'll just run it from the developer menu.

Thanks again,
Tim
 
Upvote 0

Forum statistics

Threads
1,213,506
Messages
6,114,024
Members
448,543
Latest member
MartinLarkin

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