PDA

View Full Version : [SOLVED] Export multiple worksheets into one csv file



golphtech
09-12-2013, 09:41 AM
I am looking for way to export multiple worksheets from a single workbook to a single csv file (or to a new excel file). I've been googling all over with no luck. Total VB noob here. Thanks for any help!!

SamT
09-12-2013, 11:32 AM
Golphtech,

Welcome to the best VBA forum on the web.

Unless all the sheets have exactly the same column labels with exactly the same types of information, you really DON'T want to put them all in the same csv file.

Unless: If you were to paste all the sheets except Row #1 into one sheet with each sheet's Rows pasted under the preceeding sheet's, the new sheet still makes sense.

Does that make sense? Sometimes I'm as clear as thick Missouri mud.

Kenneth Hobs
09-12-2013, 12:00 PM
Post a very short example file. As Sam said, to make a true master CSV file, sheet columns need to have the same structure.

golphtech
09-12-2013, 12:33 PM
I came up with a code but still trying to figure out how to attach it here. Thanks for all the replies! Really appreciate it!

SamT
09-12-2013, 12:49 PM
In the Reply Editor, click the # button on the menu and paste your code in between the two code tags that appear. Alternately you can type the tags before and after your code.



...Your code here...
Ignore the words "HTML Code:"

stanleydgrom
09-12-2013, 03:44 PM
golphtech,

Welcome to the VBA Express forum.

If posting VBA code, please use Code Tags - like this:




'Paste your code here.

golphtech
09-12-2013, 05:34 PM
Thanks for the reply everyone! Basically, what I came up with is creating a new workbook that imports data from another workbook. It works but I need to clean/tune the code, I think a loop might do the trick! Any suggestions is greatly appreciated.



Sub Import()

Const sRANGE = "B3:I65536"

' Hide screen updates
Application.ScreenUpdating = False

' Start with clean worksheet
Cells.Select
Selection.ClearContents

' Open source file
Workbooks.Open Filename:="IP Matrix.xlsx"

' Copy Sheet1
Sheets("01").Select
Range(sRANGE).Select
Selection.Copy
Windows("IP Import.xlsm").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Copy Sheet 2
Windows("IP Matrix.xlsx").Activate
Sheets("02").Select
Range(sRANGE).Select
Application.CutCopyMode = False
Selection.Copy
Windows("IP Import.xlsm").Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Copy Sheet 3
Windows("IP Matrix.xlsx").Activate
Sheets("03").Select
Range(sRANGE).Select
Application.CutCopyMode = False
Selection.Copy
Windows("IP Import.xlsm").Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Copy Sheet 4
Windows("IP Matrix.xlsx").Activate
Sheets("04").Select
Range(sRANGE).Select
Application.CutCopyMode = False
Selection.Copy
Windows("IP Import.xlsm").Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Copy Sheet 5
Windows("IP Matrix.xlsx").Activate
Sheets("05").Select
Range(sRANGE).Select
Application.CutCopyMode = False
Selection.Copy
Windows("IP Import.xlsm").Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Copy Sheet 6
Windows("IP Matrix.xlsx").Activate
Sheets("06").Select
Range(sRANGE).Select
Application.CutCopyMode = False
Selection.Copy
Windows("IP Import.xlsm").Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Copy Sheet 7
Windows("IP Matrix.xlsx").Activate
Sheets("07").Select
Range(sRANGE).Select
Application.CutCopyMode = False
Selection.Copy
Windows("IP Import.xlsm").Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Copy Sheet 8
Windows("IP Matrix.xlsx").Activate
Sheets("08").Select
Range(sRANGE).Select
Application.CutCopyMode = False
Selection.Copy
Windows("IP Import.xlsm").Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Copy Sheet 9
Windows("IP Matrix.xlsx").Activate
Sheets("09").Select
Range(sRANGE).Select
Application.CutCopyMode = False
Selection.Copy
Windows("IP Import.xlsm").Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Copy Sheet 10
Windows("IP Matrix.xlsx").Activate
Sheets("10").Select
Range(sRANGE).Select
Application.CutCopyMode = False
Selection.Copy
Windows("IP Import.xlsm").Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Copy Sheet Others
Windows("IP Matrix.xlsx").Activate
Sheets("Others").Select
Range(sRANGE).Select
Application.CutCopyMode = False
Selection.Copy
Windows("IP Import.xlsm").Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Remove unnecessary columns
Columns("B:G").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select

' Close source
Windows("IP Matrix.xlsx").Activate
Application.DisplayAlerts = False
ActiveWindow.Close

End Sub

SamT
09-12-2013, 06:52 PM
See if this makes sense to you.

Option Explicit

Sub Import()
Dim CB As Workbook 'Copy Book
Dim CSs As Variant 'Copy Sheets
Dim PS As Worksheet 'Paste Sheet
Dim i As Long 'Iteration Counter
Const LR As Long = Application.Rows.Count 'LastRow

Workbooks.Open Filename:="IP Matrix.xlsx"
Set CB = Workbooks("IP Matrix.xlsx")
CSs = Split("01,02,03,04,05,06,07,08,09,10,Others", ",", -1, 1)
Set PS = Workbooks("IP Import.xlsm").Sheets("") 'Unknown. You must set

' Hide screen updates
Application.ScreenUpdating = False

' Start with clean worksheet
PS.Cells.ClearContents

'Copy and paste from each sheet in CSs
For i = 0 To UBound(CSs)
CB.Sheets(CSs(i)).Range(Range("B3"), Cells(LR, "I").End(xlUp)).Copy
PS.Range(LR, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Next i

' Remove unnecessary columns and empty Row 1
With PS
.Columns("B:G").Delete
.Rows(1).Delete
.Range("A1").Select
End With

' Close source
Application.DisplayAlerts = False
CB.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

snb
09-13-2013, 01:08 AM
Welcome to the best VBA forum on the web.

Did you compare with all German, Dutch, Spanish, Russian and Chinese fora ? Or are you being a 'little' too US-centric ? ;) :)

snb
09-13-2013, 01:19 AM
or


sub M_snb()
with getobject("G:\OF\IP Matrix.xlsx")
for each sh in .sheets
sn=sh.usedrange.offset(2,1)

for j=1 to ubound(sn)-2
c00=c00 & vbcrlf & join(application.index(sn,j,0),",")
next
next

close false
end with

createobject("scripting.filesystemobject").createtextfile("G:\OF\together.csv").write c00
End Sub

SamT
09-13-2013, 06:11 AM
And he takes one for the team! :boxer2:

@ Golphtech,

snb's code will create a csv file named together.csv from all the sheets in IP Matrix.xlsx

snb
09-13-2013, 06:41 AM
Ouch, that hurts ! ;)

golphtech
09-13-2013, 08:33 AM
Wow! Thanks for the codes, I'll definitely work on these now! Will post an update soon! Much appreciated SamT and snb!

golphtech
09-13-2013, 08:58 AM
Hi SamT, I am getting a Debug error on line "Const LR As Long = Application.Rows.Count 'LastRow". It says Constant expression required. Not sure what to enter there, also on the "Set PS", do I just assign the sheet number where all the data will be dumped? Thanks for all your help!!

golphtech
09-13-2013, 09:18 AM
Thanks snb! Quick question on the code, how can I export the csv to a generic path such as %USERPROFILE%\Desktop. I'll be sharing the macro with a number of people so I was hoping for a more generic path without users having to modify the code. Thanks again!!

Kenneth Hobs
09-13-2013, 10:06 AM
createobject("scripting.filesystemobject").createtextfile(CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\together.csv").write c00

golphtech
09-13-2013, 10:30 AM
Thanks Kenneth! It worked perfectly! Thanks again!!

SamT
09-13-2013, 12:20 PM
Const LR As Long = Application.Rows.Count

You just need to change it to a variable inside the sub

Dim LR as Long
LR = Application.Rows.Count

snb
09-13-2013, 02:57 PM
If you like ADO:


Sub sheets_in_active_workbook_to_csv_ADO()
' reference Microsoft ActiveX Data Object 2.0

For Each sh In Sheets
With New ADODB.Recordset
.Open "SELECT * FROM `" & sh.Name & "$`", "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sh.Parent.FullName & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
c00 = c00 & .GetString(, , ",", vbCrLf)
End With
Next

CreateObject("scripting.filesystemobject").createtextfile(CreateObject("wscript.shell").specialfolders(4) & "\together.csv").write c00
End Sub

golphtech
09-13-2013, 04:16 PM
If you like ADO:


Sub sheets_in_active_workbook_to_csv_ADO()
' reference Microsoft ActiveX Data Object 2.0

For Each sh In Sheets
With New ADODB.Recordset
.Open "SELECT * FROM `" & sh.Name & "$`", "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sh.Parent.FullName & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
c00 = c00 & .GetString(, , ",", vbCrLf)
End With
Next

CreateObject("scripting.filesystemobject").createtextfile(CreateObject("wscript.shell").specialfolders(4) & "\together.csv").write c00
End Sub

Thanks snb! How do I customize the code? When I run it on my source workbook I get a "type not defined" error on line "With New ADODB.Recordset". Many thanks!

golphtech
09-13-2013, 04:17 PM
You just need to change it to a variable inside the sub

Dim LR as Long
LR = Application.Rows.Count

Thanks SamT, I'm still trying to figure this one out. Regards!

Kenneth Hobs
09-13-2013, 04:27 PM
I would reference the MDAC 2.8 library. As standard practice, Compile code, before you run it. The Compile button can be added to the VBE toolbar.


' reference Microsoft ActiveX Data Object 2.0

' Set Reference in Tools > References to: Microsoft ActiveX Data Objects 2.8 Library

golphtech
09-13-2013, 04:37 PM
or


sub M_snb()
with getobject("G:\OF\IP Matrix.xlsx")
for each sh in .sheets
sn=sh.usedrange.offset(2,1)

for j=1 to ubound(sn)-2
c00=c00 & vbcrlf & join(application.index(sn,j,0),",")
next
next

close false
end with

createobject("scripting.filesystemobject").createtextfile("G:\OF\together.csv").write c00
End Sub

Hi snb, for the "Ubound(sn)-2" syntax, what is the "-2" for? Thanks!

snb
09-14-2013, 02:21 AM
Because you wanted to start in row 3, we had to move the desired range (usedrange) to row 3. That means that the last 2 rows will be empty and have to be discarded. Since the ubound of the array that contains that range indicates the number of rows, we can/should ignore the last 2 rows, hence Ubound(sn)-2.

snb
09-14-2013, 03:18 AM
@KH

No Microsoft ActiveX Data Objects 2.8 Library on my sytem (Excel 2010), only Microsoft ActiveX Data Objects 2.0 Library

There is a Microsoft ActiveX Data Objects (multidimensional) 2.8 Library, but that doesn't contain the 'recordset'.

JKwan
09-16-2013, 08:30 PM
You probably need to reference "Microsoft ActiveX Data Object 2.x".
Just in case you don't know how to do it, in your VBA editor, goto Tools - Reference

golphtech
09-17-2013, 11:43 AM
Thanks for all the help guys!

SamT
09-17-2013, 12:59 PM
Golphtech, Should you mark the thread Solved?