仅从 CSV 导出包含数据的行

Question

我创建了一个宏来导出 CSV。我遇到的问题是它正在导出所有内容，甚至是空白单元格。

A/B 列是必填字段。如果 A/B 列中没有数据，则该行将为空白。

Sub ExportAsCSV()

    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook
    Dim dtToday As String
    
    dtToday = Format(Date, "MM.DD.YY")
    
    Set CurrentWB = ActiveWorkbook
    ActiveWorkbook.ActiveSheet.UsedRange.Copy

    Set TempWB = Application.Workbooks.Add(1)
    
    With TempWB.Sheets(1).Range("A1")
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
    End With

    MyFileName = CurrentWB.Path & "\" & "ARMs Upload " & dtToday & ".csv"
    'Optionally, comment previous line and uncomment next one to save as the current sheet name
    'MyFileName = CurrentWB.Path & "\" & CurrentWB.ActiveSheet.Name & ".csv"

    Application.DisplayAlerts = False
    TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    TempWB.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub

Answer 1

您可以在粘贴后删除任何不完整的行：

Sub ExportAsCSV()

    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook
    Dim dtToday As String, rng As Range, i As Long
    
    dtToday = Format(Date, "MM.DD.YY")
    
    Set CurrentWB = ActiveWorkbook
    Set rng = CurrentWB.ActiveSheet.UsedRange '<<<
    rng.copy

    Set TempWB = Application.Workbooks.Add(1)
    
    With TempWB.Sheets(1).Range("A1")
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
    End With
    
    'remove any pasted rows without a value in Cols A and B
    For i = rng.Rows.Count To 2 Step -1
        With TempWB.Sheets(1).Rows(i)
            If Application.CountA(.Range("A1:B1")) < 2 Then .Delete
        End With
    Next i

    MyFileName = CurrentWB.Path & "\" & "ARMs Upload " & dtToday & ".csv"
    'Optionally, comment previous line and uncomment next one to save as the current sheet name
    'MyFileName = CurrentWB.Path & "\" & CurrentWB.ActiveSheet.Name & ".csv"


    Application.DisplayAlerts = False
    TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    TempWB.Close SaveChanges:=False
    Application.DisplayAlerts = True

End Sub