我创建了一个vba宏，目的是：1）逐个打开文件夹中的每个文件2）遍历每个工作表，取消保护每个工作表，看看顶行是否为空（如果是，则删除它）并删除一个有问题的专栏。 3）将文件另存为xlsx。
到目前为止，我已经设法让它遍历每个文件，但无法遍历工作表。我之前能够让它对每个工作簿中的最后一个活动工作表进行更改，但现在它似乎跳过了每个工作表。
知道为什么吗？
Sub LoopThroughFiles()
FolderName = ThisWorkbook.Path & "\Source Data\"
If Right(FolderName, 1) <> Application.PathSeparator Then FolderName = FolderName & Application.PathSeparator
Fname = Dir(FolderName & "*.xls*")
'loop through the files
Do While Len(Fname)
With Workbooks.Open(FolderName & Fname)
Dim folderPath As String
Dim filename As String
Dim wb As Workbook
Dim ws As Worksheet
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
'Unshare Workbook
If ActiveWorkbook.MultiUserEditing Then
ActiveWorkbook.ExclusiveAccess
End If
'Unprotect Workbook
ActiveWorkbook.Unprotect "pa55word"
For Each ws In ThisWorkbook.Worksheets
'Unprotect Worksheet
ws.Unprotect "pa55word"
'Unhide Columns and Rows
ws.Cells.EntireColumn.Hidden = False
ws.Cells.EntireRow.Hidden = False
'Delete Blank top Row
Set MR = ws.Range("A1:C1")
For Each cell In MR
If cell.Value = "" Then cell.EntireRow.Delete
Next
'Delete annoying Column
Set MR = ws.Range("A1:BZ1")
For Each cell In MR
If cell.Value = "a2a" Then cell.EntireColumn.Delete
Next
'Remove Filter
If ws.AutoFilterMode Then
ws.ShowAllData
ws.AutoFilterMode = False
End If
Next ws
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Cleansed Data\" & Replace(Replace(ActiveWorkbook.Name, ".xlsx", ""), ".xls", "") & ".xlsx", FileFormat:=51
ActiveWorkbook.Close
End With
' go to the next file in the folder
Fname = Dir
Loop
End Sub
您正在使用ActiveSheet在循环中取消保护。
把它改成这个：
For Each ws In ThisWorkbook.Worksheets
'Unprotect Worksheet
ws.Unprotect "pa55word" 'instead of ActiveSheet.Unprotect ~
否则它会受到保护，您无法进行更改。一般情况下，避免使用ActiceCell，ActiveSheet等 - How to avoid using Select in Excel VBA
此外，设置MR范围如下：
'Delete Blank top Row
Set MR = ws.Range("A1:C1")
For Each cell In MR
If cell.Value = "" Then cell.EntireRow.Delete
Next
'Delete annoying Column
Set MR = ws.Range("A1:BZ1")
For Each cell In MR
If cell.Value = "2a2" Then cell.EntireColumn.Delete
Next
在设置范围时，您必须参考ws父级。否则它需要ActiveSheet。
在这里：
If ws.AutoFilterMode Then
ws.ShowAllData
ws.AutoFilterMode = False
End If
它始终是Excel.Object，Workbook.Object，Worksheet.Object和Range.Object;总共4个对象。请看一下这个链接。
http://www.excelfunctions.net/Excel-Objects.html
另外，请看这个链接。
http://www.excel-easy.com/vba/examples/loop-through-books-sheets.html
所以，现在有了新的教育，你就可以做好实际的工作了。
Sub Example()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String, Fnum As Long
Dim mybook As Workbook
Dim CalcMode As Long
Dim sh As Worksheet
Dim ErrorYes As Boolean
'Fill in the path\folder where the files are
MyPath = "C:\Users\Ron\test"
'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If
'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If
'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop
'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
On Error GoTo 0
If Not mybook Is Nothing Then
'Change cell value(s) in one worksheet in mybook
On Error Resume Next
With mybook.Worksheets(1)
If .ProtectContents = False Then
.Range("A1").Value = "My New Header"
Else
ErrorYes = True
End If
End With
If Err.Number > 0 Then
ErrorYes = True
Err.Clear
'Close mybook without saving
mybook.Close savechanges:=False
Else
'Save and close mybook
mybook.Close savechanges:=True
End If
On Error GoTo 0
Else
'Not possible to open the workbook
ErrorYes = True
End If
Next Fnum
End If
If ErrorYes = True Then
MsgBox "There are problems in one or more files, possible problem:" _
& vbNewLine & "protected workbook/sheet or a sheet/range that not exist"
End If
'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub