每个工作表的 VBA 循环答案

【问题标题】：VBA Loop For Each Worksheet每个工作表的 VBA 循环
【发布时间】：2021-09-11 15:55:42
【问题描述】：

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

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

【问题讨论】：

“但它也只保存工作表”是什么意思？
您有 With xWs 但 Range("A3").Select 指的是活动工作表。也许你需要点，即.Range().Columns()和.Cells()
@SuperSymmetry 此代码不是选择删除其他工作表中的选择，它只是删除激活工作表中的选择，但将所有工作表保存在工作簿中。对不起我的语言，我的英语不太好
@CDP1802 for with 和点我有错误 Method or data member not found

标签： excel vba loops for-loop each

【解决方案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

【讨论】：