VBA Loop For Each Worksheet - excel

Question

I am working on code to basically go through each sheet in my Workbook, and then selection delete and at finish save all worksheets to csv. I don't receive any errors, but it also only save worksheets.
Any help is greatly appreciated!
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

When using With prefix ranges with a dot.
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