Macro to copy column from multiple files to paste to one file

[yonidf99]

I created a macro that creates an excel file with different tabs. The thing is I need the macro to go into folder C:\Documents and go through every file in the folder and copy column C from tab "taxes" and transpose to row 1, then row 2 for the second file, row 3 for the third file... however many files there are (different number every time) of the new spreadsheet tab "taxes 2007", then copy column D from tab "taxes" of every file and transpose to row 1, 2, 3... of the new spreadsheet tab "taxes 2008". I can't figure this out! My boss thinks I'm so good at macros

[Yongle]

Time to be honest with the boss. Otherwise the pressure will intensify. Ask for some time to undertake macro training.

[Yongle]

Hope this code gets you somewhere close
Remember to put the consolidating file containing this code in another folder.
Just in case of any problems I attach my workbook (macro included) plus the 3 small files I put into the folder to prove it worked
If this solves your thread can you go to Thread Tools above and mark as "Solved"
thanks
Yon

Sub Consolidate()
         
' Modify this folder path to point to the files you want to use.
        FolderPath = "C:\Documents\"
        Dim LastRowC As Long, LastRowD As Long
        Dim RngC As Range, RngD As Range, RngCT As Range, RngDT As Range
        Set WbConsol = ActiveWorkbook
' Call Dir the first time, pointing it to all Excel files in the folder path.
        Filename = Dir(FolderPath & "*.xl*")
' Loop until Dir returns an empty string.
    Do While Filename <> ""
' Open a workbook in the folder
        Set WorkBk = Workbooks.Open(FolderPath & Filename)
' set ranges to copy
        LastRowC = WorkBk.Sheets("Taxes").Cells(Rows.Count, "C").End(xlUp).Row
        LastRowD = WorkBk.Sheets("Taxes").Cells(Rows.Count, "D").End(xlUp).Row
        Set RngC = WorkBk.Sheets("Taxes").Range("C1:C" & LastRowC)
        Set RngD = WorkBk.Sheets("Taxes").Range("D1:D" & LastRowD)
' Copy Column C and paste to next row in sheet Taxes2007
        NextRowC = WbConsol.Sheets("Taxes2007").Cells(Rows.Count, "A").End(xlUp).Row + 1
        Set RngCT = WbConsol.Sheets("Taxes2007").Range("A" & NextRowC)
        RngC.Copy
        RngCT.PasteSpecial Transpose:=True
' Copy Column D and paste to next row in sheet Taxes2008
        NextRowD = WbConsol.Sheets("Taxes2008").Cells(Rows.Count, "A").End(xlUp).Row + 1
        Set RngDT = WbConsol.Sheets("Taxes2008").Range("A" & NextRowD)
        RngD.Copy
        RngDT.PasteSpecial Transpose:=True
' close the source worksheet without saving
        WorkBk.Close savechanges:=False
' Use Dir to get the next file name.
        Filename = Dir()
    Loop   'end of Filename loop
 
   ' Range("A1").Select
End Sub

[snb]

@Yongle

You might use:

Sub M_snb()
   sn=filter(split(createobject("wscript.shell").exec("cmd /c Dir ""C:\Documents\*.*xl*"" /b").stdout.readall,vbcrlf),"xl")

   for j=0 to ubound(sn)
     with getobject(sn(j))
    thisworkbook.sheets("taxes2007").cells(rows.count,1).end(xlup).offset(1).resize(,.sheets(1).usedrange.rows.count)=application.transpose(.sheets(1).usedrange.columns(3))
    .close 0
    end with 
   next
End Sub

[Yongle]

@snb
Now why didn't I think of that?

[Yongle]

@snb - having examined your sub, I can see where the 2nd half comes from, but I am a bit lost with the first bit.

Can you explain (to a non-programmer) the bits in blue:
sn=filter(split(createobject("wscript.shell").exec("cmd /c Dir ""C:\Documents\*.*xl*"" /b").stdout.readall,vbcrlf),"xl")
thanks

[snb]

use the shell library: createobject("wscript.shell")
read the result of the command "cmd dir *": .stdout.readall
split this result (a text string) into a 1-dimensional array by vbcrlf : split(... , vbcrlf)
filter from this array only those elements ('rows") that contain the string "xl"
resulting in array sn

[Yongle]

@snb thanks. My brain is hurting. Perhaps I should try to incorporate these segments into my code gradually!

[snb]

You can:

Sub M_snb()
 c00="C:\Documents\"
 c01 ="*.*xl*"
 c02="cmd /c Dir """ & c00 & c01 & """ /b/s"
 c03=createobject("wscript.shell").exec(c02).stdout.readall
 
 sp=split(c03,vbCrLf)
 sn=filter(sp,"xl")

 for j=0 to ubound(sn)
  with getobject(sn(j))
   thisworkbook.sheets("taxes2007").cells(rows.count,1).end(xlup).offset(1).resize(,.sheets(1).usedrange.rows.count)=application.transpose(.sheets(1).usedrange.columns(3))
   .close 0
  end with 
 next
End Sub

step throgh the code with F8
see what happens in the 'Locals' window in the VBEditor.

[Yongle]

@snb
Something needs to be modified in this line:

c03 = CreateObject("wscript.shell").exec(c02).stdout.readall

c03 should only return files in the c:\documents\ folder - but files in sub-folders are also included
I do not understand the code, so have no idea what to change.
thanks