Question

我有一个每天都在填充的excel列表。我想将每一行（不是空白）另存为Excel工作簿。所有保存的工作簿也都需要放在同一文件夹中。

我无法使用循环

Answer 1

尝试一下，它必须完成您所要求的操作，请注意， StackOverflow 不是免费的代码编写服务...

有关您的下一个问题，请参见How To Ask，它将为您提供帮助！

最亲切的问候

Sub Create_WorkbookFromRowsWorkbook()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

On Error GoTo PROC_ERROR

Dim ThisWorkbook As Workbook, NewBook As Workbook
Dim ThisWorksheet As Worksheet, NewWs As Worksheet
Dim i As Integer, j As Integer, k As Integer, ExportCount As Integer

Set ThisWorkbook = ActiveWorkbook
Set ThisWorksheet = ThisWorkbook.Sheets("Sheet1")
ExportCount = 0

For i = 1 To 10
    If ThisWorksheet.Cells(i, 1) <> "" Then
        Set NewBook = Workbooks.Add
        Set NewWs = NewBook.Sheets("Sheet1")
        For j = 2 To 8
            If ThisWorksheet.Cells(i, j) <> "" Then
                NewWs.Cells(j - 1, 1) = ThisWorksheet.Cells(i, j)
            End If
        Next j
        For k = 9 To 10
            If ThisWorksheet.Cells(i, k) <> "" Then
                NewWs.Cells(k - 8, 2) = ThisWorksheet.Cells(i, k)
            End If
        Next k
        With NewBook
            .Sheets("Sheet2").Delete
            .Sheets("Sheet3").Delete
            .Title = ThisWorksheet.Cells(i, 1)
            .SaveAs Filename:=ThisWorksheet.Cells(i, 1) & ".csv", FileFormat:=xlCSV, CreateBackup:=False
        End With
        ExportCount = ExportCount + 1
    End If
Next i

PROC_ERROR:
If Err.Number <> 0 Then
    MsgBox "This macro has encountered an error and needs to exit. However, some or all of your exported workbooks may still have been saved. Please try again." _
    & vbNewLine & vbNewLine & "Error Number: " & Err.Number & vbNewLine & "Error Description: " & Err.Description, vbInformation
    ExportCount = 0
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Exit Sub
Else
    MsgBox "Successfully exported " & ExportCount & " workbooks!", vbInformation
    ExportCount = 0
End If

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

我可以使用什么VBA代码将每一行另存为文件夹中的单独excel工作簿

1 个答案: