分表成csv格式的文件

xiaozhiyouxi

原表是这样的，按照第一列分成3个表，每个表是csv格式的。我保存的代码是
    For Each sht In Sheets
                sht.Copy
                ActiveWorkbook.Sheets(1).Range("a:a").Delete
                ActiveWorkbook.SaveAs Filename:="C:\Users\Administrator\Desktop\" & sht.Name & sss & ".csv", FileFormat:=xlCSV
                ActiveWorkbook.Close
    Next


保存的文件

但是上传总是失败，然后如果我把保存的文件下面的空行，从6开始到最后一行，全部删除一下，就可以成功了，有没有高手指点下，是什么原因？或者添加什么代码让他自动删除下面的空行？

wbperfect

http://club.excelhome.net/thread-1511572-1-1.html

3190496160

Sub 拆分()
Set d = CreateObject("scripting.dictionary")
    ar = Sheet1.[a1].CurrentRegion
    Set Rng = Sheet1.Rows(1)
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            If Not d.exists(Trim(ar(i, 1))) Then
                Set d(Trim(ar(i, 1))) = Sheet1.Range("a" & i).Resize(1, UBound(ar, 2))
            Else
                Set d(Trim(ar(i, 1))) = Union(d(Trim(ar(i, 1))), Sheet1.Range("a" & i).Resize(1, UBound(ar, 2)))
            End If
        End If
    Next i
    x = d.keys
    Application.SheetsInNewWorkbook = 1
    For i = 0 To UBound(x)
        Set wb = Workbooks.Add
        With wb.Worksheets(1)
            Rng.Copy .[a1]
            d.items()(i).Copy .[a2]
            .Name = x(i)
        End With
        wb.SaveAs Filename:=ThisWorkbook.Path & "\" & x(i) & ".csv", FileFormat:=xlCSV
        wb.Close True
    Next i
End Sub

3190496160

Desktop.rar (14.86 KB, 下载次数: 3)

2020-2-14 12:45 上传

点击文件名下载附件