PDA

View Full Version : Consolidating Multiple Sheets into One File



Scotteh
01-12-2016, 04:36 AM
Hi All,

First time on here and VBA virgin, currently trying to get my head around it.

I've searched the forum and come across a previous thread which I believe has my answer but, I cannot seem to get it to do what it should. It doesn't error, it just doesn't consolidate the sheets and I'm not sure why.

My aim is just to consolidate multiple sheets in one excel file into a single csv file with no spaces at the top. All the column names are the same in each sheet and I'd like a single set of headers present at the top of the consolidated file (taken from one of the sheets) and then all the data to be listed one after the other from the sheets below the headers.

Hope that makes sense!





Sub Consolidate()
With GetObject("Z:\Projects\Card Rec\Card_NEW.xlsm")
For Each sh In .Sheets
sn = sh.UsedRange.Offset(0, 0)

For j = 1 To UBound(sn) - 1
c00 = c00 & vbCrLf & Join(Application.Index(sn, j, 0), ",")
Next
Next

Close False
End With

CreateObject("scripting.filesystemobject").createtextfile("Z:\Projects\Card Rec\together.csv").write c00
End Sub



TIA, Scott

snb
01-12-2016, 07:43 AM
Sub M_snb()
With GetObject("Z:\Projects\Card Rec\Card_NEW.xlsm")
For Each sh In .Sheets
sn = sh.UsedRange

For j = 1 To UBound(sn) - 1
c00 = c00 & vbCrLf & Join(Application.Index(sn, j), ",")
Next
Next

.Close 0
End With

CreateObject("scripting.filesystemobject").createtextfile("Z:\Projects\Card Rec\together.csv").write c00
End Sub

Scotteh
01-12-2016, 08:06 AM
Hi snb,

Thanks for replying, I just tried using the one above, which is just a modified version of your original. It's the one I found in another thread and was working with :)

Unfortunately, I get the same result. I tried it with your '. Close 0' and with the original 'Close False', the latter produces the file where as '.Close 0' closes excel and doesn't produce any file. After removing the close, it produced the file, but again, only contained one of the sheets and has a space at the top of the excel (this part isn't massively important).

Any ideas?

snb
01-12-2016, 10:08 AM
Open Excel first, put this code somewhere in a macro module and run it.

Because you hadn't loaded Excel it will be 'quit' by the command .close and because of that reason can't finish the macro.

second alternative:


Sub M_snb()
With GetObject("Z:\Projects\Card Rec\Card_NEW.xlsm")
For Each sh In .Sheets
sn = sh.UsedRange

For j = 1 To UBound(sn) - 1
c00 = c00 & vbCrLf & Join(Application.Index(sn, j), ",")
Next
Next
CreateObject("scripting.filesystemobject").createtextfile("Z:\Projects\Card Rec\together.csv").write c00
.Close 0
End With

End Sub

Scotteh
01-13-2016, 02:18 AM
Same result, it will create the 'together.csv' file but, it does not contain the second sheet. It only contains data (correctly I might add), from the first sheet.

Annoying as it seems to process the macro without error, just not include all sheets.

snb
01-13-2016, 03:32 AM
I can hardly believe it.
You can check with:


Sub M_snb()
With GetObject("Z:\Projects\Card Rec\Card_NEW.xlsm")
For Each sh In .Sheets
msgbox sh.name
sn = sh.UsedRange

For j = 1 To UBound(sn) - 1
c00 = c00 & vbCrLf & sh.name & Join(Application.Index(sn, j), ",")
Next
Next
CreateObject("scripting.filesystemobject").createtextfile("Z:\Projects\Card Rec\together.csv").write c00
.Close 0
End With

End Sub

Scotteh
01-13-2016, 09:42 AM
You star, thanks snb!

That helped to debug it for sure; turns out the other sheet was about a thousand lines below the other first sheet in the 'together' file.

What you've provided works a treat, thanks again.

snb
01-13-2016, 12:55 PM
If you know that sheets do not contain 'empry rows', upi can use:


Sub M_snb()
With GetObject("Z:\Projects\Card Rec\Card_NEW.xlsm")
For Each sh In .Sheets
sn = sh.cells(1).currentregion

For j = 1 To UBound(sn) - 1
c00 = c00 & vbCrLf & Join(Application.Index(sn, j), ",")
Next
Next
CreateObject("scripting.filesystemobject").createtextfile("Z:\Projects\Card Rec\together.csv").write c00
.Close 0
End With
End Sub