每个工作表的VBA循环

Question

我正在编写代码，基本上要浏览工作簿中的每一张工作表，然后选择删除，最后将所有工作表保存到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

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