VBA to copy paste data with multiple workbooks

[Tosborn]

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:

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 . 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

 

[netuser]

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

 

[RichardMGreen]

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.

 

[Tosborn]

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

 

[netuser]

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.

 

[Tosborn]

Hey Netuser,

Just d7:e20 for each sheet.

Thanks so much for this again,
Tim

 

[netuser]

Here you go, change path and your workbook name as indicated in comments

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

 

[Tosborn]

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

 

[netuser]

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 :

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

 

[Tosborn]

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