VBA Combine two ranges from two sheets into one CSV file

[Lars1]

Hi.

Hope anyone can help with this issue.

I have two sheets with one dynamic list i both sheets i would like to combine to one CSV file.

Today i am exporting one range from one sheet to a CSV file, usint the code below, and this works perfectly.
Now i would like to add data from another range from another sheet to this same CSV file.

The format and number of columns are exactly the same in both sheets.
Number of rows is dynamic.

I would like to include this range in to the CSV file also:
Sheet = "Sheet2"
Range = "A2:D2"


Public Sub Save_Range_CSV_COMBINED()

Dim cellData As Variant, i As Long, j As Long
Dim lines() As String

With Sheets("Produktionsordre")
cellData = .Range("A2:D2").Resize(.Cells(.Rows.Count, "A").End(xlUp).Row).value
End With

ReDim lines(1 To UBound(cellData))
i = 1
For j = 1 To 4
lines(i) = lines(i) & cellData(i, j) & ","
Next
lines(i) = lines(i) & "LAGER"
For i = 2 To UBound(cellData)
For j = 1 To 4
lines(i) = lines(i) & cellData(i, j) & ","
Next
lines(i) = lines(i) & "LAGER"
Next

Open "C:\test\PROD " & Format(Now, "DD-MM-YYYY HH MM") & ".txt" For Output As #1
Print #1, Join(lines, vbCrLf)
Close #1

Dim csvFile As String
csvFile = "C:\test\PROD " & Format(Now, "DD-MM-YYYY HH MM") & ".txt"
Open csvFile For Output As #1
Print #1, Join(lines, vbCrLf)
Close #1
MsgBox "Filen er gemt: " & csvFile


End Sub

 

[Joe4]

Wouldn't it just be easier to copy the data from the one sheet to the other sheet, and then just create one CSV file from that combined sheet of data?

 

[Lars1]

Wouldn't it just be easier to copy the data from the one sheet to the other sheet, and then just create one CSV file from that combined sheet of data?

Both lists are dynamic.
If it´s possible to copy from List 2 and paste in to the end of List, then it would be a solution...

 

[Joe4]

Both lists are dynamic.
If it´s possible to copy from List 2 and paste in to the end of List, then it would be a solution...

Yes, it is pretty easy to copy dynamic lists.

Depending on how your data is structured, there are various ways of doing it.
If all your data is contiguous, and starts in cell A1, you can simply use Current Region, i.e.

Range("A1").CurrentRegion.Copy

And then you can paste it dynamically by finding the first blank cell in column A on the sheet you are pasting to like this:

Cells(Rows.Count, "A").End(xlUp).Offset(1,0).Select

 

[Lars1]

Yes, it is pretty easy to copy dynamic lists.

Depending on how your data is structured, there are various ways of doing it.
If all your data is contiguous, and starts in cell A1, you can simply use Current Region, i.e.

Range("A1").CurrentRegion.Copy

And then you can paste it dynamically by finding the first blank cell in column A on the sheet you are pasting to like this:

Cells(Rows.Count, "A").End(xlUp).Offset(1,0).Select

Thanks for your solution.
Unfortunately i am not very familiar with VBA,
Is it possible for you to implement your solution in my original Code ?

 

[Joe4]

See if this does what you want (I documented the code so you can follow along and see what each step does):

Sub CreateCSVMacro()

    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim lr As Long
    Dim fname As String
   
    Application.ScreenUpdating = False
   
'   Capture current workbook
    Set wb1 = ActiveWorkbook
   
'   Add new workbook
    Workbooks.Add
   
'   Capture new workbook
    Set wb2 = ActiveWorkbook
   
'   Go back to original workbook and find last row on Produktionsordre sheet
    wb1.Activate
    Sheets("Produktionsordre").Activate
    lr = Cells(Rows.Count, "A").End(xlUp).Row
   
'   Copy data starting at row 2 to new workbook
    Range("A2:D" & lr).Copy
    wb2.Activate
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
   
'   Go back to original workbook and find last row on Sheet2
    wb1.Activate
    Sheets("Sheet2").Activate
    lr = Cells(Rows.Count, "A").End(xlUp).Row
   
'   Copy data starting at row 2 to new workbook
    Range("A2:D" & lr).Copy
    wb2.Activate
    Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
   
'   Create file name to save new workbook
    fname = "C:\test\PROD " & Format(Now, "DD-MM-YYYY HH MM") & ".csv"
   
'   Save file as CSV
    ActiveWorkbook.SaveAs Filename:=fname, FileFormat:=xlCSV, CreateBackup:=False
   
'   Close workbook
    ActiveWindow.Close
   
    Application.ScreenUpdating = True
   
    MsgBox "CSV file successfully saved to: " & fname, vbOKOnly, "MACRO COMPLETE!"
   
End Sub