VBA 循环每个工作表

Question

我正在编写代码，基本上遍历工作簿中的每个 sheet，然后选择删除并在完成时将所有工作sheet 保存到 csv。我没有收到任何错误，但它也只保存了 worksheets。非常感谢任何帮助！

Public Sub SaveWorksheetsAsCsv()

Dim xWs As Worksheet
Dim xDir As String
Dim folder As FileDialog

Set folder = Application.FileDialog(msoFileDialogFolderPicker)
If folder.Show <> -1 Then Exit Sub
xDir = folder.SelectedItems(1)
For Each xWs In Application.ActiveWorkbook.Worksheets

    With xWs
   Range("A3").Select
   Range(Selection, Selection.End(xlToRight)).Select
   Range(Selection, Selection.End(xlDown)).Select
   Selection.Copy
   Range("AU1").Select
   Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
   Columns("A:AT").Select
   Range("AT1").Activate
   Application.CutCopyMode = False
   Selection.Delete Shift:=xlToLeft
   Range("A1").Select
   Cells.Replace What:="(puste)", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    End With

xWs.SaveAs Filename:=xDir & "\" & xWs.Name, FileFormat:=xlCSV, Local:=True

Next
End Sub

Answer 1

使用带点的 With 前缀范围时。

Option Explicit

Public Sub SaveWorksheetsAsCsv()

    Dim xWs As Worksheet, xDir As String, msg As String
    Dim folder As FileDialog
    
    Set folder = Application.FileDialog(msoFileDialogFolderPicker)
    If folder.Show <> -1 Then Exit Sub
    xDir = folder.SelectedItems(1)
   
    Application.ScreenUpdating = False
    For Each xWs In Application.ActiveWorkbook.Worksheets
    
        With xWs
            msg = msg & vbCrLf & xWs.Name
            .Range(.Range("A3"), .Range("A3").End(xlToRight).End(xlDown)).Copy
            .Range("AU1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
                 xlNone, SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
            .Columns("A:AT").Delete Shift:=xlToLeft
           
            .UsedRange.Cells.Replace What:="(puste)", Replacement:="", LookAt:=xlPart, _
                 SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                 ReplaceFormat:=False ', FormulaVersion:=xlReplaceFormula2
            .SaveAs Filename:=xDir & "\" & .Name, FileFormat:=xlCSV, Local:=True
            '.Activate ' optional
            '.Range("A1").Select ' optional
        End With

    Next
    Application.ScreenUpdating = True
    MsgBox "Sheets saved :" & msg, vbInformation
End Sub

VBA 循环每个工作表

VBA Loop For Each Worksheet

excel

vba

loops

for-loop

each