VBA to save rows as XLSX without empty rows

[Jorgi]

HI All,

Could you be so kind and help me with this VBA code. The macro is working perfectly and does what needs to be done apart from saving a file in CSV but I would like to save it in XLSX, please? . If I change this:
"Open ThisWorkbook.Path & "\FilenameABC.csv" For Output As #F" to "Open ThisWorkbook.Path & "\FilenameABC.xlsx" For Output As #F" won't be able to open the saved file. Thank you for your help

Sub Demo1()
Dim F%, Rw As Range
F = FreeFile
Open ThisWorkbook.Path & "\FilenameABC.csv" For Output As #F
With Application
For Each Rw In ActiveSheet.UsedRange.Columns("B:AZ").Rows
If (Rw.Cells.Count - .CountBlank(Rw)) > 1 Then Print #F, Join(.Index(Rw.Value2, 1, 0), ",")
Next
End With
Close #F
End Sub

 

[Domenic]

I think you'll need to find a different approach. Here's one approach...

Option Explicit

Sub Demo1()

    Dim foundCells As Range
    Dim rw As Range
    For Each rw In ActiveSheet.UsedRange.Columns("B:AZ").Rows
        If (rw.Cells.Count - Application.CountBlank(rw)) > 1 Then
            If foundCells Is Nothing Then
                Set foundCells = rw.Cells
            Else
                Set foundCells = Union(foundCells, rw.Cells)
            End If
        End If
    Next rw
    
    If foundCells Is Nothing Then
        MsgBox "No data found!", vbExclamation
        Exit Sub
    End If

    Dim newWorkbook As Workbook
    Set newWorkbook = Application.Workbooks.Add(xlWBATWorksheet)
    
    foundCells.Copy Destination:=newWorkbook.Worksheets(1).Range("A1")
    
    newWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\FilenameABC.xlsx", FileFormat:=xlOpenXMLWorkbook
    
    newWorkbook.Close

End Sub

Hope this helps!

 

[Jorgi]

Thank you Domenic it works thank you so much but is there a possibility to save it without formatting / without colourful background, borders etc.,?

 

[Domenic]

To copy/paste values only, try replacing...

foundCells.Copy Destination:=newWorkbook.Worksheets(1).Range("A1")

with

    foundCells.Copy
   
    newWorkbook.Worksheets(1).Range("A1").PasteSpecial xlPasteValues

Hope this helps!

 

[Jorgi]

Thank you so much

 

[Domenic]

You're very welcome, cheers!