Save certain rows to a csv file

[Elliottj2121]

Hello I am trying to copy rows to a new workbook and save that workbook as a CSV file. I am somewhat familiar with VBA and know how to copy rows to a different sheet within the same workbook but am stuck on figuring out how to move them to a new workbook and then save the new workbook as a CSV file.

Clarifying information:
If there is a value in column B then copy the entire row to the new workbook including the header row which is "A4:R4"
Columns are static between A & H but the number of rows can change.
The CSV file path can change so saving it to environ"USERPROFILE" is needed.

Thank you in advance.

Private Sub CommandButton2_Click()
Dim xRg As Range, xCell As Range
Dim i As Long, j As Long, k As Long
Dim wsI As Worksheet, wsO As Worksheet
Dim wbI As Workbook, wbO As Workbook
Set wsI = Worksheets("CheckImport")
Set wbO = Workbook.Add
wsO = wbO.Worksheets("Sheet1")
i = wsI.Cells(Rows.Count, 1).End(xlUp).Row
j = wbO.worsheets("Sheet1").UsedRange.Rows.Count


Set xRg = wsI.Range("B5:B" & i)
On Error Resume Next
Application.ScreenUpdating = False

For k = 1 To xRg.Count
    If CStr(xRg(k).Value) <> "" Then
    xRg(k).EntireRow.Copy Destination:=wb0.Worksheets("Sheet1").Range("A" & j + 1)
    End If
Next
Application.ScreenUpdating = True

End Sub

 

[RobP]

Hi,

your code below with a few modifications / typo corrections. See if this gets you where you want to be. You might want to use a pathname to know where your new file will be saved also.
cheers
Rob

Private Sub CommandButton2_Click()
Dim xRg As Range, xCell As Range
Dim i As Long, j As Long, k As Long
Dim wsI As Worksheet, wsO As Worksheet
Dim wbI As Workbook, wbO As Workbook

Set wsI = Worksheets("CheckImport")
Set wbO = Application.Workbooks.Add
Set wsO = wbO.Worksheets("Sheet1")

i = wsI.Cells(Rows.Count, 2).End(xlUp).Row
j = wbO.Worksheets("Sheet1").UsedRange.Rows.Count


Set xRg = wsI.Range("B5:B" & i)
On Error Resume Next
Application.ScreenUpdating = False

For k = 1 To xRg.Count
    If CStr(xRg(k).Value) <> "" Then
    'xRg(k).EntireRow.Copy Destination:=wb0.Worksheets("Sheet1").Range("A" & j + 1)
    wsO.Range("A" & j + 1).EntireRow.Value = wsI.Rows(i - xRg.Count + k).Value
    j = j + 1
    End If
Next
Application.ScreenUpdating = True

ActiveWorkbook.SaveAs Filename:="Output_File", FileFormat:=xlCSV

End Sub

 

[Elliottj2121]

Hi,

your code below with a few modifications / typo corrections. See if this gets you where you want to be. You might want to use a pathname to know where your new file will be saved also.
cheers
Rob

Private Sub CommandButton2_Click()
Dim xRg As Range, xCell As Range
Dim i As Long, j As Long, k As Long
Dim wsI As Worksheet, wsO As Worksheet
Dim wbI As Workbook, wbO As Workbook

Set wsI = Worksheets("CheckImport")
Set wbO = Application.Workbooks.Add
Set wsO = wbO.Worksheets("Sheet1")

i = wsI.Cells(Rows.Count, 2).End(xlUp).Row
j = wbO.Worksheets("Sheet1").UsedRange.Rows.Count


Set xRg = wsI.Range("B5:B" & i)
On Error Resume Next
Application.ScreenUpdating = False

For k = 1 To xRg.Count
    If CStr(xRg(k).Value) <> "" Then
    'xRg(k).EntireRow.Copy Destination:=wb0.Worksheets("Sheet1").Range("A" & j + 1)
    wsO.Range("A" & j + 1).EntireRow.Value = wsI.Rows(i - xRg.Count + k).Value
    j = j + 1
    End If
Next
Application.ScreenUpdating = True

ActiveWorkbook.SaveAs Filename:="Output_File", FileFormat:=xlCSV

End Sub

Thank you so much! This worked. I added a path and it works perfectly!!

 

[RobP]

Great, thanks for the feedback. Glad we could help.

Rob