• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copy Data from Several Workbooks

S

Shah

New Member
Hello All,

I have written a few basic macros which copy data from several workbooks and past it into a separate template. I would like to condense the macros as I think the current macros are not the best approach. I have attached a file which shows the macros and dummy file names and folder. Any input will be much appreciated.

Thanks,
Shah.
 

Attachments

Hi Shah,

It would help a lot if you could go through your macros and add comments, detailing what is going on, and/or what the purpose of each code is. Now only would this help us know what you are trying to do, but it is generally considered good practice to comment your code, in case you later forget, or someone else down the line has to inherit your code.
 

Hi Shah !

To support what Luke M says :

always code as if the guy who ends up maintaining your code will be a violent psychopath
who knows where you live !
​
 
Thanks for replies guys. Yes I agree with you guys. Maybe I was lazy and didn't add any comments as I was thinking it is only a copy paste job!. Basically all the macros are copying data from separate workbooks. I will go through one code and the rest are just based on this with some tweaks. I will send another file in the morning with comments in each macro.

Code: 
Sub SummaryOfCash()

    Dim lRow As Long, x As Long, y As Long
    Dim wbCopy As Workbook
    Dim wsCopy As Worksheet
    Dim rngCopy As Range
    Dim wbPaste As Workbook
    Dim wsPaste As Worksheet
    Dim rngPaste As Range
   

   'This is specifying which file to open and which sheet to copy data. Column K gives the directory where the 
'file is saved and Column D has the sheet names. Then the range is set from A6 to K till there is any data.

    Set wbCopy = Workbooks.Open(ThisWorkbook.Sheets("File Name").Range("K5").Value)
    Set wsCopy = wbCopy.Sheets(ThisWorkbook.Sheets("File Name").Range("D5").Value)
    Set rngCopy = wsCopy.Range("A6:K" & Range("A6").End(xlDown).Row)
   
'This is the sheet where the data is pasted. Again Column C has the name of the workbook and Column D has the sheet name. 
    Set wbPaste = Workbooks(ThisWorkbook.Sheets("File Name").Range("C12").Value)
    Set wsPaste = wbPaste.Worksheets(ThisWorkbook.Sheets("File Name").Range("D12").Value)
    Set rngPaste = wsPaste.Range("A2")
   
'Copy and paste data
    rngCopy.Copy
    rngPaste.PasteSpecial
   
    'Close the workbook   
    Workbooks(ThisWorkbook.Sheets("File Name").Range("C5").Value).Close savechanges:=False
   
End Sub

Thanks,
Shah.
 
Hi Shah

It might be a better idea to move all of your column data at once. A loop can take some time to run. I could not see a folder so just created my own. You could take the following coding and incorporate all of the files and criteria in one procedure. This would make things easier I think. Anyways here is my take.


Code: 
Option Explicit
 
Sub MoveCols()
Dim st As Variant
Dim dst As Variant
Dim i As Integer
Dim ws As Worksheet
Dim wb As Workbook
Dim lw As Long
 
Set ws = Sheet1
Set wb = Workbooks.Open("D:OpenMe.xls")
lw = Sheets("OSheet").Range("A" & Rows.Count).End(xlUp).Row
st = [{13, 1, 10, 9}] 'Start
dst = [{1, 2, 9, 10}] 'Destination
 
  For i = 1 To UBound(st) 'Loop through the Array
    Sheets("OSheet").Range(Cells(2, st(i)), Sheets("OSheet").Cells(lw, st(i))).Copy ws.Cells(2, dst(i))
  Next i
    ws.Range("C2:D" & ws.Cells(Rows.Count, 1).End(xlUp).Row) = [{"LQD FUNDS","=E2"}]
    ws.Range("K2:K" & ws.Cells(Rows.Count, 1).End(xlUp).Row) = "VLOOKUP(I2,'FX Rates'!B:C,2,0)*J2"
    wb.Close 'Close the workbook
End Sub


Tested this on my machine and it ran OK.

Take care

Smallman
 
Hi Smallman,

Thanks a lot for this. Could you please go through the macro with me. What are the numbers i.e. 13, 1 etc and how do I add multiple spreadsheets and various columns of data I need to copy? Please see attached a Template I use to add data to. So macro run from a separate spreadsheets opens the Template and then open the data files one by one and copy the data to relevant sheet in Template.

Thanks,
Shah.
 

Attachments

Hi Smallman,

Your macro works for one file. How do I make it to go through the list of files and copy different columns...
I have tweaked the macro slightly:

Code: 
Option Explicit

Sub MoveCols()
Dim st As Variant
Dim dst As Variant
Dim i As Integer
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim wb As Workbook
Dim wbCopy As Workbook
Dim wsCopy As Worksheet
Dim lw As Long


    Set wb = Workbooks.Open(ThisWorkbook.Sheets("File Name").Range("K12").Value) 'Data destination template directory
    Set ws = Worksheets(ThisWorkbook.Sheets("File Name").Range("D12").Value)     'Data destination template sheet name
    Set ws1 = Worksheets(ThisWorkbook.Sheets("File Name").Range("D13").Value)    'Data destination template sheet name

    'Data spreadsheets
   
    Set wbCopy = Workbooks.Open(ThisWorkbook.Sheets("File Name").Range("K5").Value) 'Data file destination
    Set wsCopy = wbCopy.Sheets(ThisWorkbook.Sheets("File Name").Range("D5").Value)  'Data file sheet name
   
   
        lw = wsCopy.Range("A" & Rows.Count).End(xlUp).Row
        st = [{1,2,3,4,5,6,7,8,9,10}] 'Start
        dst = [{1,2,3,4,5,6,7,8,9,10}] 'Destination

  For i = 1 To UBound(st) 'Loop through the Array
   wsCopy.Range(Cells(6, st(i)), wsCopy.Cells(lw, st(i))).Copy ws.Cells(2, dst(i))
   wsCopy1.Range(Cells(6, st(i)), wsCopy.Cells(lw, st(i))).Copy ws.Cells(2, dst(i))
  Next i
    ws.Range("D2:D" & ws.Cells(Rows.Count, 1).End(xlUp).Row) = [{"=E2"}] '"LQD FUNDS"
    ws.Range("K2:K" & ws.Cells(Rows.Count, 1).End(xlUp).Row) = "=VLOOKUP(I2,'FX Rates'!B:C,2,0)*J2"
      
    wbCopy.Close 'Close the workbook
End Sub
 
Hi Shah

You are probably using a few too many columns IMO. I have played around with your file and ran the macro on the following coding. It runs OK. I have some questions though. Your numbers in the above example are sequential – if you are going to run this process you would not use this method if the data was sequential, 1,2,3 etc. Your initial example had non continuous columns. This process can be done more efficiently with consecutive columns at one end or the other. I have designed the following on you importing staggered columns of data.

I use Columns 6 – 13 to store where the data will hit based on your original example. Anyways I hope the following helps.

Code: 
Option Explicit
 
Sub MoveCols2()
Dim ar As Variant ' Column Number
Dim var As Variant ' Sheet Name
Dim i As Integer
Dim ws As Worksheet
Dim wb As Workbook
Dim lw As Long
Dim j As Integer
Set ws = Sheet1
ar = Range("F2", Range("M" & Rows.Count).End(xlUp))
var = Range("C2", Range("C" & Rows.Count).End(xlUp))
 
For j = 2 To Range("B" & Rows.Count).End(xlUp).Row
    Set wb = Workbooks.Open(Range("E" & j)) 'File Path & Name
    lw = Sheets(var(j - 1, 1)).Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To 4 'Loop through the Array
      Sheets(var(j - 1, 1)).Range(Cells(2, ar(j - 1, i)),  _
      Sheets(var(j - 1, 1)).Cells(lw, ar(j - 1, i))).Copy ws.Cells(2, ar(j - 1, i + 4))
    Next i
    wb.Close 'Close the workbook
Next j
End Sub

In the first post I showed you how you might push formula into a column. I trust you can leverage that to your needs. I have uploaded a file to show how I would set something like this up. You will see it is very different from your original set up. Happy to answer any questions.

Take care

Smallman
 

Attachments

Last edited:
Hi Smallman,

Thanks a lot for this. I have tried the macro but it stops at
Code: 
 lw = Sheets(var(j - 1, 1)).Range("A" & Rows.Count).End(xlUp).Row
Getting type mismatch error.

Well there are 9 data spreadsheets and from some spreadsheet I will need to copy the data from Column A to K. From others it will be some columns and not necessarily sequential. Although my original macro works but the aim is to have one macro which could accommodate all the routines as it will be easier to debug and add comments when making changes etc.

I see your set-up is different but it would not be a problem to follow it.

Thanks,
Shah.
 
Last edited:
Hi Shah

If I was to guess, I would say your problem is my file was set up so the headings were in Column 1. I made some changes to your file. You did not follow this set up so you get an error.

I have streamlined your file and I recommend you use this as a template and you will get the code to run through.

Alternatively if you can't get it working post a couple of workbooks that you open and import and we should be able to get it working. Be very clear about what columns you want imported and don't post another file with nothing it it. Put some data as that Template sheet (above) was blank and I need to see data in the file.

I would like to see you have a crack first though as the code is working at this end and if you follow the set up of the attached file, you should be able to get it to work too.

Take care

Smallman
 
Hi Smallman,

Thanks yes the file was the problem. I have amended the macro to copy data from all the spreadsheets. I am not sure if this can be condensed further. I have attached the Macro file plus the template.
Let me know what you think of it?

I am stuck on one thing. The following bit. I would like to copy if the Data file Column I has "Net Projected Balance (GBP)". I would like to copy Columns K-P to the Template and transpose and paste in Column J. Also I would like Column A to be populated with 301371 for the same number of rows.

Code: 
        For j = 7 To 7
            Set wb = Workbooks.Open(ThisWorkbook.Sheets("FileName").Range("E" & j))
            Sheets(var(j - 1, 1)).Activate
            lRow = Sheets(var(j - 1, 1)).Range("B65535").End(xlUp).Row
            For x = 2 To lRow
            If Sheets(var(j - 1, 1)).Range("I" & x).Value = "Net Projected Balance (GBP)" Then 'Copy data if Column I is equal to "Net Projected Balance (GBP)"
               
                wsCash.Range("A" & Rows.Count).End(xlUp).Offset(1) = "301371" 'Column A will have value 301371
                wsCash.Range("I" & Rows.Count).End(xlUp).Offset(1) = Sheets(var(j - 1, 1)).Range("C" & x).Value 'Column I will have value from Column C Data file
                wsCash.Range("J" & Rows.Count).End(xlUp).Offset(1) = Sheets(var(j - 1, 1)).Range("K" & x).Value 'Column I will have value from Column K Data file
                                 
            End If
            Next x
                wb.Close 'Close the workbook
        Next j

Thanks,
Shah.
 

Attachments

Hi Shah

You have moved a long way from the coding principles I showed you above in the file you attached. I have done my best to clean your file up but it is starting to be a pretty long process. Maybe you could look at some of the line fixes I have made a and learn something but as for your problem above I don't really understand what you are asking in the first part. I believe the second part is there in my fix.

Take care

Smallman
 

Attachments

Hello Smallman,

Thanks a lot for the pointers and cleaning up the mess. I am a novice hence sometimes don't write code the right way. Learned a few things the latest iteration. I have solved the problem I had by learning about the SpecialCells. The code is a little more condensed and better written.

I have one question. If say a data file is missing the macro gives an error. Is there anyway to tell the macro to ignore a missing file?

I have attached an amended macro. Hope this is a better attempt from me.

Thanks,
Shah.
 

Attachments

Hi Shah

I have made some more comments in your file. You seem to get some of the concepts I am introducing to you but not all. Have a read of the comments and the further reading on the topic. If you adopt the rules from the reading your coding will improve a great deal.

Take care

Smallman
 

Attachments

Thank you for this Smallman.

I am getting error from this bit of the code: Maybe I am doing something wrong..

Code: 
    Set sh = Sheet2 'This is the  file name sheet (best practice sheet referencing).
    Set wb = Sheet2.[E12] ' Daily Cash Forecasting workbook
    Set wsCash = Sheet2.[C12] ' Cash sheet on Template
    Set wsData = Sheet2.[C13]  ' Data sheet on Template
    Set wsFX = Sheet2.[C14]  ' FX Rates sheet on Template

I have replaced it with this: The Template is a separate workbook which is opened before importing data from all the Data files.
Code: 
    Set sh = Sheet2 'This is the  file name sheet
    Set wb = Workbooks.Open(sh.[E11].Value)     ' Daily Cash Forecasting workbook
    Set wsCash = Worksheets(sh.[C11].Value)     ' Cash sheet on Template
    Set wsData = Worksheets(sh.[C12].Value)     ' Data sheet on Template
    Set wsFX = Worksheets(sh.[C13].Value)       ' FX Rates sheet on Template

My final code is this (this also includes clearing some cells on Data sheet depending on account code and saving the file): Not sure why wsCash and wsData was declared As Long?

Code: 
Sub CashProjectionData()
Dim ar As Variant ' Column Number
Dim var As Variant ' Sheet Name
Dim i As Integer
Dim j As Integer
Dim x As Long
Dim wb As Workbook
Dim wsCash As Worksheet
Dim wsData As Worksheet
Dim wsFX As Worksheet
Dim ws As Worksheet
Dim lw As Long
Dim lRow As Long
Dim LGIMPass As Variant
Dim lr As Long
Dim sh As Worksheet
Dim ThisFile As Variant

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
   
'Open Template where all the data is imported

    Set sh = Sheet2 ' Macro worksheet
    Set wb = Workbooks.Open(sh.[E11].Value)     ' Daily Cash Forecasting workbook
    Set wsCash = Worksheets(sh.[C11].Value)     ' Cash sheet on Template
    Set wsData = Worksheets(sh.[C12].Value)     ' Data sheet on Template
    Set wsFX = Worksheets(sh.[C13].Value)       ' FX Rates sheet on Template

    ar = sh.Range("F2", sh.Range("M" & Rows.Count).End(xlUp)) 'Column data is picked up from F2 to M
    var = sh.Range("C2", sh.Range("C" & Rows.Count).End(xlUp))
    LGIMPass = sh.[A3].Value 'Password for Portected file

'Copy data for a given columns only.

       For j = 2 To 3
            Set wb = Workbooks.Open(sh.Range("E" & j)) 'File Path & Name
            lw = Sheets(var(j - 1, 1)).Range("A" & Rows.Count).End(xlUp).Row
            Sheets(var(j - 1, 1)).Range("A6:J" & lw).Copy wsCash.Range("A" & Rows.Count).End(xlUp).Offset(1) 'Copy A6:J as long as there is data
            If wsCash.Range("A" & Rows.Count).End(xlUp) = "P 12876" Then 'The account number
            wsCash.Range("C" & Rows.Count).End(xlUp) = "LQD FUNDS" 'Paste value
            End If
            wb.Close 'Close the workbook
       Next j
     
           
'Copy data for a given columns only.

       For j = 4 To 5
            Set wb = Workbooks.Open(sh.Range("E" & j), Password:=LGIMPass) 'File Path & Name
            lw = Sheets(var(j - 1, 1)).Range("B" & Rows.Count).End(xlUp).Row
            For i = 1 To 4   'Loop through the Array
                Sheets(var(j - 1, 1)).Range(Cells(2, ar(j - 1, i)), Sheets(var(j - 1, 1)).Cells(lw, ar(j - 1, i))).Copy wsCash.Cells(Rows.Count, ar(j - 1, i + 4)).End(xlUp).Offset(1, 0)
            Next i
            wb.Close 'Close the workbook
        Next j
   
'Copy data for a given columns only.

            j = 6
            Set wb = Workbooks.Open(sh.Range("E" & j)) 'File Path & Name
            Sheets(var(j - 1, 1)).Activate
            lw = Sheets(var(j - 1, 1)).Range("B" & Rows.Count).End(xlUp).Row
            For i = 1 To 4   'Loop through the Array
               Sheets(var(j - 1, 1)).Range(Cells(6, ar(j - 1, i)), Sheets(var(j - 1, 1)).Cells(lw, ar(j - 1, i))).Copy wsCash.Cells(Rows.Count, ar(j - 1, i + 4)).End(xlUp).Offset(1, 0)
            Next i
            wb.Close 'Close the workbook
     
'Fill in formula to get account number from text in column B
       
            lr = wsCash.Range("B" & Rows.Count).End(xlUp).Row
            wsCash.Range("A2:A" & lr).SpecialCells(4) = "=IFERROR(IF(LEFT(MID(RC2,FIND(""   "",RC2,1)-5,5),1)="" "",0&MID(RC2,FIND(""   "",RC2,1)-4,4),MID(RC2,FIND(""   "",RC2,1)-5,5)),MID(RC[1],25,5))"

'Fill LQD FUNDS in column C where appropriate
           
            wsCash.Range("C2:C" & lr).SpecialCells(4) = "LQD FUNDS"
       
'Copy data from...
               
            j = 7
            Set wb = Workbooks.Open(sh.Range("E" & j))
            lRow = Sheets(var(j - 1, 1)).Range("B65535").End(xlUp).Row
            For x = 2 To lRow
            If Sheets(var(j - 1, 1)).Range("I" & x).Value = "Net Projected Balance (GBP)" Then 'Copy data if Column I is equal to "Net Projected Balance (GBP)"
                wsCash.Range("A" & Rows.Count).End(xlUp).Offset(1) = "301371" 'Column A will have value 301371
                wsCash.Range("I" & Rows.Count).End(xlUp).Offset(1) = Sheets(var(j - 1, 1)).Range("C" & x).Value 'Column I will have value from Column C Data file
                wsCash.Range("J" & Rows.Count).End(xlUp).Offset(1) = Sheets(var(j - 1, 1)).Range("K" & x).Value 'Column I will have value from Column K Data file
                   
                Sheets(var(j - 1, 1)).Range("E" & x & ":H" & x).Copy
                wsData.Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Transpose:=True 'Copy Columns E to H and transpose and paste on Data tab
                wsData.Range("D" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "=WORKDAY(R[-1]C,1)" 'Next working day date in next cell
                Sheets(var(j - 1, 1)).Range("L" & x & ":P" & x).Copy
                wsData.Range("J" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Transpose:=True 'Copy Columns L to P and transpose and paste on Data tab
            End If
            Next x
            wb.Close 'Close the workbook
           
        lr = wsData.Range("J" & Rows.Count).End(xlUp).Row
        wsData.Range("A2:A" & lr).SpecialCells(4) = "301371" 'Fill column A with 301371
        wsData.Range("I2:I" & lr).SpecialCells(4) = "GBP"    'Fill column A with GBP
       
        lr = wsCash.Range("A" & Rows.Count).End(xlUp).Row
        wsCash.Range("D2:D" & lr) = wsCash.[E2].Value  'Column D populated with same data as Column E
        wsCash.Range("K2:K" & lr) = "=VLOOKUP(I2,'FX Rates'!B:C,2,0)*J2" 'V-lookup to get the exchange rate from Sheet Named FX Rates
        wsCash.Range("L2:L" & lr) = "=IF(ISERROR(LOOKUP(2,1/($P$2:$P$80=A2)/($Q$2:$Q$80=I2),($R$2:$R$80))),VLOOKUP(A2,$P$2:$R$80,3,FALSE),(LOOKUP(2,1/($P$2:$P$80=A2)/($Q$2:$Q$80=I2),($R$2:$R$80))))" 'V-lookup to get the FM name from Columns P,Q and R
        wsCash.Range("A2:J" & lr).Copy wsData.Range("A" & Rows.Count).End(xlUp).Offset(1) 'Copy data from Template "Cash" tab to "Data" tab
                   
       
'Copy data from Cash Projection.

            j = 8
            Set wb = Workbooks.Open(sh.Range("E" & j)) 'File Path & Name
            lw = Sheets(var(j - 1, 1)).Range("A" & Rows.Count).End(xlUp).Row
            Sheets(var(j - 1, 1)).Range("A7:J" & lw).Copy wsData.Range("A" & Rows.Count).End(xlUp).Offset(1) 'Copy A6:J as long as there is data
            wb.Close 'Close the workbook
       
'Copy data from FX rates.

            j = 9
            Set wb = Workbooks.Open(sh.Range("E" & j)) 'File Path & Name
            lw = Sheets(var(j - 1, 1)).Range("A" & Rows.Count).End(xlUp).Row
            Sheets(var(j - 1, 1)).Range("A6:D" & lw).Copy wsFX.Range("A" & Rows.Count).End(xlUp).Offset(1) 'Copy A6:J as long as there is data
            wb.Close 'Close the workbook
               
        lr = wsData.Range("A" & Rows.Count).End(xlUp).Row
        wsData.Range("K2:K" & lr) = "=VLOOKUP(I2,'FX Rates'!B:C,2,0)*J2" 'V-lookup to get the exchange rate from Sheet Named FX Rates
        wsData.Range("L2:L" & lr) = "=IF(ISERROR(LOOKUP(2,1/($P$2:$P$80=A2)/($Q$2:$Q$80=I2),($R$2:$R$80))),VLOOKUP(A2,$P$2:$R$80,3,FALSE),(LOOKUP(2,1/($P$2:$P$80=A2)/($Q$2:$Q$80=I2),($R$2:$R$80))))" 'V-lookup to get the FM name from Columns P,Q and R
         
'Clear cells depending on the account code from Data tab

            With wsData.UsedRange
                .AutoFilter Field:=1, Criteria1:="45365", Operator:=xlOr, Criteria2:="74564"
                '.AutoFilter Field:=1, Criteria1:="74564"
                .Range("A2" & ":L10000").ClearContents
                .AutoFilter
            End With
       
       
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   
'Save Template as a dated file in Cash Projection data folder
           
        ThisFile = sh.[E10].Value
        Workbooks("Daily Cash Forecasting").SaveAs Filename:=ThisFile, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
       
End Sub

Thanks,
Shah.
 
Last edited:
Hi Shah

In post 10 you had the following;

Dim wsCash, wsData

In VBA the above line is like writing nothing at all.

So I took the liberty of declaring the variables on your behalf. I guess the ws is a bit of a give away but I just declared them and moved on. There was a lot of really messy code and just sifting through it all was a bit of a task.

All of this;

Code: 
   Set wsCash = Worksheets(sh.[C11].Value)    ' Cash sheet on Template
Set wsData = Worksheets(sh.[C12].Value)    ' Data sheet on Template
Set wsFX = Worksheets(sh.[C13].Value)      ' FX Rates sheet on Template

Could be something like this;

Code: 
  Set wsCash = sh.[C11].Value    ' Cash sheet on Template
  Set wsData = sh.[C12].Value    ' Data sheet on Template
  Set wsFX = sh.[C13].Value

Logically should do exactly the same thing and you should not need to use .Value at the end. Do you have a final file?

I tried very hard to show you in the code that this was not necessary

Code: 
.Offset(1)

If you do a find and replace the above with

Code: 
.(2)


Where you are looping through the ranges one cell at a time that could be vastly improved. I provided some reading on the subject. Here it is again for anyone following who may be interested.

http://www.ozgrid.com/forum/showthread.php?t=177019

I tend to avoid loops like the plague when I have to test for a condition. Special cells and Autofilters work better.

Take care

Smallman
 
Last edited:
Hi Smallman,

Thank you. I have now started declaring variables properly (before I didn't quite understand them, I will read up a bit more on them). Thank you for the link.

Please see attached the final file. Appreciate your help.

Thanks,
Shah.
 

Attachments

You must log in or register to reply here.
Back
Top