仅导出包含CSV数据的数据集

siotufzp  于 2023-10-13  发布在  其他
关注(0)|答案(1)|浏览(111)

我创建了一个宏来导出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
5f0d552i

5f0d552i1#

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

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

相关问题