如何修改VBA宏以循环格式化工作簿中所有工作表？

你的判断完全正确，固定指定Sheet1的写法确实没法实现遍历所有工作表的需求，而且原代码还有几处细节问题需要调整，下面是修正后的完整代码：

Option Explicit

Sub FormattingAllSheets()
    Dim ws As Worksheet
    Dim cell As Range
    Dim rng1, rng2, rng3, rng4 As Range
    Dim FinalRow As Long
    Dim chapter As String
    
    ' 遍历工作簿中的每一张工作表
    For Each ws In ActiveWorkbook.Worksheets
        With ws
            ' 找到A列最后一行有数据的行号
            FinalRow = .Range("A" & .Rows.Count).End(xlUp).Row
            
            ' 取消A3到最后一行的单元格合并
            Set rng1 = .Range("A3:A" & FinalRow)
            rng1.Unmerge
            
            ' 处理B列空单元格：同步左侧单元格的值和格式
            Set rng2 = .Range("B3:B" & FinalRow)
            For Each cell In rng2
                If cell.Value = "" Then
                    cell.Font.Name = cell.Offset(0, -1).Font.Name
                    cell.Font.Size = cell.Offset(0, -1).Font.Size
                    cell.Font.FontStyle = cell.Offset(0, -1).Font.FontStyle
                    cell.VerticalAlignment = cell.Offset(0, -1).VerticalAlignment
                    cell.Value = cell.Offset(0, -1).Value
                End If
            Next cell
            
            ' 删除A列，自动适配行高
            Set rng3 = .Range("A:A")
            rng3.EntireColumn.Delete
            .Rows.AutoFit
            
            ' 提取章节信息并设置工作表名称
            chapter = .Range("A" & FinalRow).Value
            .Range("D3").Value = Mid(chapter, 44, 4)
            .Range("D3").Font.Name = "Arial"
            .Range("D3").Font.Size = 8
            .Name = .Range("D3").Value
        End With
    Next ws
End Sub

关键修改点说明 #

• 新增For Each ws In ActiveWorkbook.Worksheets循环，实现自动遍历工作簿内所有工作表
• 所有Range、Cells对象前都添加了.（在With ws块内），确保操作的是当前遍历的工作表，避免引用活动表导致的错误
• 修正了原代码中Cells.VerticalAlignment的错误，改为cell.VerticalAlignment，避免误修改整个工作表的垂直对齐方式
• 移除了固定指定Sheet1的代码，替换为动态遍历逻辑
• 调整了With ws的位置，使其正确作用于当前遍历的工作表

内容的提问来源于stack exchange，提问作者Hank