分割分割范圍超過Usedrange的文件時，防止宏vba復制粘貼空行

Question

我在這里找到了一個代碼，它非常適合我想要做的事情，即將一個大的 excel 文件分割成更小的 csv 文件。 但是，在檢查輸出 csv 時，當剩余的行數小於循環中的數字時，輸出會復制並粘貼空行，如圖所示。 有什么辦法可以防止這種情況在循環內部發生嗎？ 提前致謝。

Dim rLastCell As Range
Dim rCells As Range
Dim strName As String
Dim lLoop As Long, lCopy As Long
Dim wbNew As Workbook

With Sheets("Sheet1")
Set rLastCell = .UsedRange.Find(What:="*", After:=[A1], SearchDirection:=xlPrevious)

For lLoop = 2 To rLastCell.Row Step 3000
    lCopy = lCopy + 1
    Set wbNew = Workbooks.Add
    .Rows(1).EntireRow.Copy _
    Destination:=wbNew.Sheets(1).Range("A1")
    .Range(.Cells(lLoop, 1), .Cells(lLoop + 3000, .Columns.Count)).EntireRow.Copy _
    Destination:=wbNew.Sheets(1).Range("A2")
    wbNew.SaveAs Filename:="C:\Users\Documents" & 
    "product_catalog_" & fileDate & "_" & Format(lLoop + 2999, "0000") & ".csv", 
    FileFormat:=xlCSV, 
    Local:=True
    wbNew.Close SaveChanges:=True
    Next lLoop
    End With

Answer 1

為了做到這一點，我引入了一個名為 rowsToDo 的變量，最小值為 3000 或剩余的行數：

Sub testCSV()
    Dim rLastCell As Range
    Dim rCells As Range
    Dim strName As String
    Dim lLoop As Long, lCopy As Long
    Dim wbNew As Workbook
    
    With Sheets("CSV Table")
        Set rLastCell = .UsedRange.Find(What:="*", After:=[A1], SearchDirection:=xlPrevious)
    
        For lLoop = 2 To rLastCell.Row Step 3000
            rowsToDo = rLastCell.Row - lLoop
            If rowsToDo > 3000 Then rowsToDo = 3000
            lCopy = lCopy + 1
            Set wbNew = Workbooks.Add
            .Rows(1).EntireRow.Copy Destination:=wbNew.Sheets(1).Range("A1")
            .Range(.Cells(lLoop, 1), .Cells(lLoop + rowsToDo, .Columns.Count)).EntireRow.Copy Destination:=wbNew.Sheets(1).Range("A2")
            wbNew.SaveAs Filename:="C:\Users\Documents" & "product_catalog_" & fileDate & "_" & Format(lLoop + 2999, "0000") & ".csv", FileFormat:=xlCSV, Local:=True
            wbNew.Close SaveChanges:=True
        Next lLoop
    End With
End Sub

請注意，然后我在復制和目標語句中使用它來獲取要復制的行數。

對我的問題進行了非常快速的模擬，雖然老實說我無法復制這個問題我很確定這應該可以解決它

Answer 2

請測試下一個方法。 在復制必要的范圍（不使用剪貼板）和計算最后一個循環的剩余非空行的確切數量方面更快。

不要忘記使用正確/必要的定義更改行fileDate = "Test" （上面的代碼中缺少...）：

Sub CreateCSVFiles()
 Dim rLastCell As Range, rCells As Range, strName As String
 Dim lLoop As Long, lCopy As Long, wbNew As Workbook
 Dim lngStep As Double, iLast As Long, lastSliceRows As Long, fileDate As String

 fileDate = "Test" 'place here your real value (missing from the shown code...)
 With Sheets("Sheet1")
    Set rLastCell = .UsedRange.Find(What:="*", After:=.Range("A1"), SearchDirection:=xlPrevious)
    lngStep = 5
    For lLoop = 2 To rLastCell.row Step lngStep
        If (rLastCell.row - 1) / lngStep Mod 2 <> 0 Then
            iLast = Int((rLastCell.row - 1) / lngStep) + 1
            lastSliceRows = (rLastCell.row - 1) - Int(rLastCell.row / lngStep) * lngStep:  'Stop
        Else
            iLast = Int(rLastCell.row / lngStep): lastSliceRows = lngStep
        End If
        lCopy = lCopy + 1
        Set wbNew = Workbooks.Add

        'much faster way to copy the necessary values, without using clipboard:
        wbNew.Sheets(1).Range("A1").EntireRow.value = .rows(1).EntireRow.value
        wbNew.Sheets(1).Range("A2").Resize(IIf(lLoop = iLast, lastSliceRows, lngStep), Columns.count).value = _
                 .Range(.cells(lLoop, 1), .cells(lLoop + IIf(lLoop = iLast, lastSliceRows, lngStep), .Columns.count)).EntireRow.value
    
        wbNew.saveas fileName:="C:\Users\Documents" & _
              "product_catalog_" & fileDate & "_" & Format(lLoop + 2999, "0000") & ".csv", _
                FileFormat:=xlCSV, Local:=True
        wbNew.Close SaveChanges:=False ' True is useless in this content, it only makes the code slower saving for the second time.
      Next lLoop
 End With
End Sub

請在測試后發送一些反饋。