PDA

View Full Version : Macro to copy column from multiple files to paste to one file



yonidf99
03-08-2015, 07:19 PM
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
03-09-2015, 06:46 AM
Time to be honest with the boss. Otherwise the pressure will intensify. Ask for some time to undertake macro training.:)

Yongle
03-09-2015, 10:44 AM
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
03-09-2015, 01:25 PM
@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
03-09-2015, 03:21 PM
@snb
Now why didn't I think of that?

Yongle
03-11-2015, 09:38 AM
@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
03-11-2015, 10:20 AM
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
03-11-2015, 10:33 AM
@snb thanks. My brain is hurting. Perhaps I should try to incorporate these segments into my code gradually!

snb
03-11-2015, 03:21 PM
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
03-13-2015, 09:24 AM
@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