常用 Excel VBA 技巧，简单好学易上手

在日常办公中，我们常常会遇到各种繁琐的数据处理任务，而 Excel VBA（Visual Basic for Applications）作为一款强大的自动化工具，能够帮助我们轻松应对这些挑战。本文将介绍一些常用且简单好学的 Excel VBA 技巧，包括文档的合并与拆分，以及如何使用 Control 配置表进行灵活配置。

在 VBA 代码中，可以通过读取 Control Sheet 中的这些参数来实现灵活配置，通过学习和掌握这些常用的 Excel VBA 技巧，如文档的合并与拆分，以及利用 Control Sheet 进行灵活配置，我们能够显著提高数据处理的效率，轻松应对各种复杂的办公任务。希望本文介绍的内容能够帮助你在日常工作中更好地发挥 Excel VBA 的强大功能。

启用 VBA 编辑器

在开始使用 VBA 之前，需要确保 Excel 中启用了开发工具选项卡。具体步骤如下：

1. 点击 "文件" 选项卡。
2. 选择 "选项"。
3. 在弹出的 "Excel 选项" 对话框中，选择 "自定义功能区"。
4. 在右侧的 "主选项卡" 列表中，勾选 "开发工具"，然后点击 "确定"。
   启用开发工具选项卡后，只需按下 "Alt + F11" 组合键，即可快速打开 VBA 编辑器。

case 1

文档拆分

有时我们需要将一个包含多个工作表的 Excel 文件拆分为多个独立的文件。以下是实现这一功能的 VBA 代码：

场景 例如将集团的数据按公司代码进行拆分

整体业务目标

该代码的主要业务目标是从一个源 Excel 文件中提取特定数据，按照一定规则进行排序和分组，例如是公司代码，然后将分组后的数据分别保存到多个新的 Excel 文件中，并且对这些新文件进行一些格式设置和保护操作。

具体需求步骤

1. 数据配置获取

• 代码从当前工作簿（主工作簿）的名为 "control" 的工作表中读取一系列配置信息，这些信息包括：
  • 源文件的文件名、所在工作表名和文件夹路径。
  • 粘贴数据的工作表名。
  • 表头的行数。有时候表头不只一行，可能是组合式的多行表头，拆分的时候要复制表头。
  • 保存文件的文件名、工作表名和文件夹路径。

2. 数据准备

• 清空主工作簿中名为 "raw" 的工作表的所有内容。
• 打开源文件和指定的工作表，将源工作表中 A 列到 I 列的数据复制到 "raw" 工作表中。

3. 数据排序

• 对 "raw" 工作表中的数据按照公司代码B 列的值进行升序排序。排序的表头设置为有表头，排序方法为按拼音排序。

4. 数据分组与保存

• 初始化一些变量，用于跟踪当前处理的数据分组情况，包括上一个值、区域、复制起始行和上一次值变化的行。
• 遍历 "raw" 工作表中的数据行（从第 2 行到最后一行）：
  • 当 B 列的值发生变化或者到达最后一行时：
    • 创建一个新的工作簿，并选择其第一个工作表作为目标工作表。
    • 将 "raw" 工作表的表头（A1 到指定列宽对应的表头行）复制到目标工作表的第一行，同时粘贴格式。
    • 根据当前行和上一次值变化的行，确定要复制的数据行范围，将这些数据行（包括格式）复制到目标工作表的第二行开始的位置。
    • 自动调整目标工作表 A 列到 I 列的列宽。
    • 对目标工作表的 I 列设置可编辑区域 ，同时对整个工作表进行保护，防止用户修改绘图对象、内容和方案。
    • 在目标工作表的第一行处冻结窗格，方便查看数据。
    • 根据配置信息和当前区域、值生成保存文件的路径和文件名，将新工作簿保存到指定位置，然后关闭该工作簿。
    • 更新上一个值、区域和复制起始行，以便处理下一个分组。

业务场景实例

要拆开的内容

实际的数据要从其他 file 获得

设置 control 配置表

代码说明

变量声明部分

vba

Dim wbMaster As Workbook
Dim wsControl As Worksheet
Dim sourceFileName As String
Dim sourceSheetName As String
Dim sourceFolderPath As String
Dim pasteSheetName As String
Dim headerRows As Long
Dim maxRows As Long
Dim saveFileName As String
Dim saveSheetName As String
Dim saveFolderPath As String
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim wsRaw As Worksheet
Dim wsTarget As Worksheet
Dim rowCount As Long
Dim pasteRow As Long
Dim lastValueChangeRow As Long
Dim copyRowRange As Range

此部分代码的作用是声明程序里要用到的各类变量，涵盖工作簿对象、工作表对象、字符串变量、长整型变量以及区域对象等。这些变量分别用于存储源文件与目标文件的相关信息、工作表对象、行数、区域范围等内容。

初始化对象与获取配置信息部分

vba

Set wbMaster = ThisWorkbook
Set wsControl = wbMaster.Sheets("control")
Set wsRaw = wbMaster.Sheets("raw")

sourceFileName = wsControl.Range("B3").Value
sourceSheetName = wsControl.Range("B4").Value
sourceFolderPath = wsControl.Range("B5").Value
pasteSheetName = wsControl.Range("B8").Value
headerRows = wsControl.Range("B9").Value
maxRows = wsControl.Range("B10").Value
saveFileName = wsControl.Range("B13").Value
saveSheetName = wsControl.Range("B14").Value
saveFolderPath = wsControl.Range("B15").Value
colWidth = wsControl.Range("D9").Value

wsRaw.Select
Cells.Select
Selection.ClearContents

• Set wbMaster = ThisWorkbook：把当前正在运行代码的工作簿赋值给 wbMaster。
• Set wsControl = wbMaster.Sheets("control") 和 Set wsRaw = wbMaster.Sheets("raw")：分别获取名为 "control" 和 "raw" 的工作表对象。
• 后续代码从 "control" 工作表的特定单元格里读取配置信息，像源文件名、源工作表名、保存文件名等。
• wsRaw.Select、Cells.Select 和 Selection.ClearContents：选中 "raw" 工作表的所有单元格并清空其内容。

打开源工作簿并复制数据部分

vba

Set wbSource = Workbooks.Open(sourceFolderPath & "\" & sourceFileName)
Set wsSource = wbSource.Sheets(sourceSheetName)

wsRaw.Range("A:I").Value = wsSource.Range("A:I").Value

endRow = wsRaw.Cells(Rows.Count, 1).End(xlUp).Row

• Set wbSource = Workbooks.Open(sourceFolderPath & "\" & sourceFileName)：依据之前获取的源文件路径和文件名打开源工作簿。
• Set wsSource = wbSource.Sheets(sourceSheetName)：获取源工作簿里指定名称的工作表对象。
• wsRaw.Range("A:I").Value = wsSource.Range("A:I").Value：把源工作表中 A 列到 I 列的数据复制到 "raw" 工作表对应的列。
• endRow = wsRaw.Cells(Rows.Count, 1).End(xlUp).Row：找出 "raw" 工作表中 A 列有数据的最后一行。

数据排序部分

vba

wsRaw.Activate
wsRaw.Sort.SortFields.Add2 Key:=Range( _
    "B2:B26275"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With wsRaw.Sort
    .SetRange Range("A1:I26275")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

• 此部分代码对 "raw" 工作表中的数据进行排序。
• wsRaw.Sort.SortFields.Add2：添加排序字段，按照 B2 到 B26275 单元格的值进行升序排序。
• With wsRaw.Sort 块：设置排序范围为 A1 到 I26275，表明有表头，不区分大小写，排序方向为从上到下，排序方法为按拼音排序，最后应用排序操作。

初始化分组变量部分

vba

lastValue = wsRaw.Cells(headerRows + 1, 2).Value
Region = wsRaw.Cells(headerRows + 1, 1).Value
rowCopyFrom = headerRows + 1
lastValueChangeRow = headerRows + 1

这部分代码对分组操作所需的变量进行初始化。lastValue 存储当前分组的判断值，Region 存储区域信息，rowCopyFrom 记录复制数据的起始行，lastValueChangeRow 记录上一次值发生变化的行。

数据分组与保存部分

vba

For rowCount = 2 To endRow
    currentValue = wsRaw.Cells(rowCount, 2).Value
    If currentValue <> lastValue Or rowCount = endRow Then
        lastValueChangeRow = rowCount

        ' 创建新工作簿
        Set NewWorkbook = Workbooks.Add
        Set wsTarget = NewWorkbook.Sheets(1)

        ' 复制表头
        Set copyRowRange = wsRaw.Range("A1:" & colWidth & headerRows)
        copyRowRange.Copy
        wsTarget.Cells(1, 1).PasteSpecial xlPasteAll
        Application.CutCopyMode = False

        ' 复制内容
        If rowCount = endRow Then
            Set copyRowRange = wsRaw.Range("A" & rowCopyFrom & ":" & colWidth & lastValueChangeRow)
        Else
            Set copyRowRange = wsRaw.Range("A" & rowCopyFrom & ":" & colWidth & lastValueChangeRow - 1)
        End If
        copyRowRange.Copy
        wsTarget.Cells(2, 1).PasteSpecial xlPasteAll
        Application.CutCopyMode = False

        ' 调整列宽
        wsTarget.Columns("A:I").EntireColumn.AutoFit

        ' 保护工作表
        wsTarget.Protection.AllowEditRanges.Add Title:="AREA1", Range:=Columns("I:I")
        wsTarget.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

        ' 冻结窗格
        wsTarget.Activate
        With ActiveWindow
            .SplitColumn = 0
            .SplitRow = 1
        End With
        ActiveWindow.FreezePanes = True

        ' 保存并关闭工作簿
        savePath = saveFolderPath & "\" & saveFileName & "_" & Region & "_" & lastValue & ".xlsx"
        NewWorkbook.SaveAs savePath
        NewWorkbook.Close

        ' 更新变量
        lastValue = currentValue
        Region = wsRaw.Cells(rowCount, 1).Value
        rowCopyFrom = rowCount
    End If
Next rowCount

• 这是一个 For 循环，会遍历 "raw" 工作表中从第 2 行到最后一行的数据。
• 当 currentValue（当前行第 2 列的值）和 lastValue 不同，或者到达最后一行时，就会进行分组操作：
  • 创建一个新的工作簿和工作表对象。
  • 复制 "raw" 工作表的表头到新工作簿的工作表中。
  • 根据当前行和上一次值变化的行，确定要复制的数据范围并复制到新工作簿的工作表里。
  • 自动调整新工作簿工作表中 A 列到 I 列的列宽。
  • 对新工作簿的工作表进行保护，允许编辑 I 列。
  • 在新工作簿的工作表第一行处冻结窗格。
  • 按照指定的规则生成保存路径和文件名，保存新工作簿并关闭。
  • 更新 lastValue、Region 和 rowCopyFrom 变量，为下一个分组做准备。

综上所述，这段代码的主要功能是读取源文件的数据，对数据进行排序和分组，然后将分组后的数据分别保存到多个新的工作簿中，同时对这些新工作簿的工作表进行格式设置和保护。

完整代码

Sub CopyData()
    Dim wbMaster As Workbook
    Dim wsControl As Worksheet
    Dim sourceFileName As String
    Dim sourceSheetName As String
    Dim sourceFolderPath As String
    Dim pasteSheetName As String
    Dim headerRows As Long
    Dim maxRows As Long
    Dim saveFileName As String
    Dim saveSheetName As String
    Dim saveFolderPath As String
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wsRaw As Worksheet
    Dim wsTarget As Worksheet
    Dim rowCount As Long
    Dim pasteRow As Long
    Dim lastValueChangeRow As Long
    Dim copyRowRange As Range

    Set wbMaster = ThisWorkbook
    Set wsControl = wbMaster.Sheets("control")
    Set wsRaw = wbMaster.Sheets("raw")


    sourceFileName = wsControl.Range("B3").Value
    sourceSheetName = wsControl.Range("B4").Value
    sourceFolderPath = wsControl.Range("B5").Value
    pasteSheetName = wsControl.Range("B8").Value
    headerRows = wsControl.Range("B9").Value
    maxRows = wsControl.Range("B10").Value
    saveFileName = wsControl.Range("B13").Value
    saveSheetName = wsControl.Range("B14").Value
    saveFolderPath = wsControl.Range("B15").Value
    colWidth = wsControl.Range("D9").Value
    
    wsRaw.Select
    Cells.Select
    Selection.ClearContents
    
    ' 打开源工作簿和工作表
    Set wbSource = Workbooks.Open(sourceFolderPath & "\" & sourceFileName)
    Set wsSource = wbSource.Sheets(sourceSheetName)
    
    wsRaw.Range("A:I").Value = wsSource.Range("A:I").Value


    endRow = wsRaw.Cells(Rows.Count, 1).End(xlUp).Row
    
    wsRaw.Activate
    wsRaw.Sort.SortFields.Add2 Key:=Range( _
        "B2:B26275"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With wsRaw.Sort
        .SetRange Range("A1:I26275")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    
    ' ?? 初始化变量
    lastValue = wsRaw.Cells(headerRows + 1, 2).Value
    Region = wsRaw.Cells(headerRows + 1, 1).Value
    rowCopyFrom = headerRows + 1
    lastValueChangeRow = headerRows + 1

    
    
    For rowCount = 2 To endRow
        currentValue = wsRaw.Cells(rowCount, 2).Value
        If currentValue <> lastValue Or rowCount = endRow Then
           lastValueChangeRow = rowCount

        
        ' company code 变化 create new workbook
        Set NewWorkbook = Workbooks.Add
        Set wsTarget = NewWorkbook.Sheets(1)
        
        '表头
        Set copyRowRange = wsRaw.Range("A1:" & colWidth & headerRows)
        ' 粘贴到目标工作表
            copyRowRange.Copy
            wsTarget.Cells(1, 1).PasteSpecial xlPasteAll ' 粘贴所有内容包括格式
            Application.CutCopyMode = False
        
        '内容
            If rowCount = endRow Then
                Set copyRowRange = wsRaw.Range("A" & rowCopyFrom & ":" & colWidth & lastValueChangeRow)
            Else
            Set copyRowRange = wsRaw.Range("A" & rowCopyFrom & ":" & colWidth & lastValueChangeRow - 1)
            End If
        ' 粘贴到目标工作表
            copyRowRange.Copy
            wsTarget.Cells(2, 1).PasteSpecial xlPasteAll ' 粘贴所有内容包括格式
            Application.CutCopyMode = False
            wsTarget.Columns("A:I").EntireColumn.AutoFit
            
            wsTarget.Protection.AllowEditRanges.Add Title:="AREA1", Range:=Columns("I:I")
            wsTarget.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
            wsTarget.Activate
                With ActiveWindow
                .SplitColumn = 0
                .SplitRow = 1
            End With
            ActiveWindow.FreezePanes = True
                
        
                savePath = saveFolderPath & "\" & saveFileName & "_" & Region & "_" & lastValue & ".xlsx"
                NewWorkbook.SaveAs savePath
                NewWorkbook.Close
            'update lastvalue
            
            lastValue = currentValue
            Region = wsRaw.Cells(rowCount, 1).Value
            rowCopyFrom = rowCount
        
        End If


    Next rowCount

End Sub

如何利用 AI 协助写代码

关键：将问题拆开为独立的小问题，不要贪心让AI 给你完整代码，逻辑一定要自己掌握。

' 方法一：自动调整整个工作表的列宽

Sub AutoFitColumnsInSheetA()

Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("SheetA")

ws.Cells.EntireColumn.AutoFit

End Sub

' 方法二：自动调整指定列范围的列宽

Sub AutoFitSpecificColumnsInSheetA()

Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("SheetA")

ws.Range("A:E").EntireColumn.AutoFit

End Sub

Set ws = ThisWorkbook.Sheets("SheetA")

' 取消工作表的保护（如果已保护）

If ws.ProtectContents Then

ws.Unprotect

End If

' 添加 I 列作为可编辑区域

ws.Protection.AllowEditRanges.Add Title:="EditableColumnI", Range:=ws.Columns("I")

' 保护工作表

ws.Protect

文档合并

业务场景

在实际工作中，经常会遇到需要将多个 Excel 文件的数据合并到一个工作表中的情况。例如，某公司不同部门每个月都会生成各自的业务数据报表，这些报表格式基本相同，但分别存储在不同的 Excel 文件中。为了进行整体的数据分析和统计，需要将这些分散的文件数据整合到一个文件里。此 VBA 代码就是为解决这类数据合并问题而设计的，它可以从指定文件夹中获取所有 Excel 文件，将它们的数据合并到一个名为 "Combine" 的工作表中，最后还能将合并后的数据保存为一个新的 Excel 文件。

处理逻辑

1. 初始化设置
   • 设定主工作簿和控制工作表，控制工作表 "control" 用于存储配置信息，如要合并的文件夹路径、表头行数等。
   • 从控制工作表中读取要合并的文件夹路径、表头行数、列宽和新文件的文件名等配置信息。
2. 目标工作表准备
   • 检查主工作簿中是否存在名为 "Combine" 的目标工作表，若不存在则创建该工作表。
   • 清空目标工作表中的所有内容，为合并数据做准备。
3. 文件遍历与数据合并
   • 对指定文件夹中的所有 Excel 文件进行遍历，记录合并的文件数量。
   • 依次打开每个 Excel 文件，假设只处理文件中的第一个工作表。
   • 找出当前打开文件中第一列有数据的最后一行。
   • 若还未复制过表头，就将当前文件的完整数据（从 A1 到 L 列最后一行）复制到目标工作表中；若已复制过表头，则只复制当前文件的数据行（从 A2 到 L 列最后一行）到目标工作表中。
   • 关闭当前处理的 Excel 文件，继续处理下一个文件。
4. 错误处理
   • 在打开 Excel 文件时，如果出现错误，会弹出消息框提示用户检查文件是否正常，然后继续处理下一个文件。
5. 合并完成提示与保存新文件
   • 当所有文件都处理完毕后，弹出消息框提示 "合并完成！"。
   • 创建一个新的工作簿，将合并数据所在的目标工作表复制到新工作簿中。
   • 按照控制工作表中指定的文件名保存新工作簿，最后关闭新工作簿。

例如之前的拆分，在收集用户的反馈后进行合并。

1. 变量声明区块

vba

Dim folderPath As String
Dim targetSheetName As String
Dim wbMaster As Workbook
Dim wsControl As Worksheet
Dim wbB As Workbook
Dim wsB As Worksheet
Dim lastRow As Long
Dim i As Long
Dim copyRowRange As Range
Dim pasteCol As Long
Dim pasteRow As Long
Dim key1 As String
Dim key2 As String
Dim key3 As String
Dim key4 As String
Dim colWidth As String
Dim rowHeight As Long
Dim checkRow As Long
Dim pasteRows As Long
Dim j As Long
Dim fileCount As Long ' 新增：用于记录合并的文件数量

功能 ：声明了宏中会用到的各种变量，涵盖字符串变量（如文件夹路径、工作表名称）、工作簿和工作表对象、长整型变量（用于记录行号等）、范围对象等。fileCount 变量用于记录合并的文件数量。

2. 设置主工作簿及控制工作表区块

vba

Set wbMaster = ThisWorkbook
Set wsControl = wbMaster.Sheets("control")

• 功能 ：将 wbMaster 设定为当前运行宏的工作簿，把 wsControl 设定为该工作簿中名为 "control" 的工作表，此工作表用于存储配置信息。

3. 获取配置信息区块

vba

folderPath = wsControl.Range("B18").Value
targetSheetName = "Combine"
headerRows = wsControl.Range("B9").Value
colWidth = wsControl.Range("D9").Value
newFileName = wsControl.Range("B19").Value

• 功能：从控制工作表 "control" 里读取配置信息，像要合并的文件夹路径（B18 单元格）、表头行数（B9 单元格）、列宽（D9 单元格）以及新文件的文件名（B19 单元格）。同时把目标工作表的名称设定为 "Combine"。

4. 设置目标工作表区块

vba

On Error Resume Next
Set wsTarget = wbMaster.Sheets(targetSheetName)
On Error GoTo 0
If wsTarget Is Nothing Then
    Set wsTarget = wbMaster.Sheets.Add(After:=wbMaster.Sheets(wbMaster.Sheets.Count))
    wsTarget.Name = targetSheetName
End If

• 功能：尝试获取主工作簿中名为 "Combine" 的目标工作表。若该工作表不存在，就会在主工作簿的最后添加一个新的工作表，并将其命名为 "Combine"。

5. 清空目标工作表内容区块

vba

wsTarget.Select
Cells.Select
Selection.ClearContents

• 功能：选中目标工作表中的所有单元格，然后清空其内容，为后续合并数据做好准备。

6. 初始化变量区块

vba

isTitleCopy = False
lastRow = 0 ' targer 的最后一行

• 功能 ：初始化两个变量，isTitleCopy 用于标记表头是否已复制，lastRow 用于记录目标工作表中数据的最后一行，初始值设为 0。

7. 文件遍历与数据合并区块

vba

folderPath = folderPath & "\"
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
Filename = Dir(folderPath & "*.xls*")
fileCount = 0 ' 初始化文件数量为 0
Do While Filename <> ""
    fileCount = fileCount + 1 ' 每次循环，文件数量加 1
    On Error GoTo OpenErrorHandler
    Set wbB = Workbooks.Open(folderPath & Filename)
    On Error GoTo 0
    Set wsB = wbB.Sheets(1) ' 这里假设只处理每个工作簿的第一个工作表，可按需修改
    endRowFrom = wsB.Cells(Rows.Count, 1).End(xlUp).Row
    copyStartRow = lastRow + 1
    If isTitleCopy = False Then
        wsB.Range("A1:L" & endRowFrom).Copy wsTarget.Range("A" & copyStartRow)
        lastRow = endRowFrom
        isTitleCopy = True
    Else
        wsB.Range("A2:L" & endRowFrom).Copy wsTarget.Range("A" & copyStartRow)
        lastRow = lastRow + endRowFrom - 1
    End If
    wbB.Close False
    Filename = Dir
Loop

• 功能 ：
  • 保证文件夹路径以反斜杠结尾。
  • 运用 Dir 函数获取指定文件夹中所有扩展名为 .xls 或 .xlsx 的文件。
  • 循环处理每个文件，每次循环时 fileCount 加 1。
  • 尝试打开文件，若出现错误则跳转到错误处理程序。
  • 假设只处理每个工作簿的第一个工作表，找出该工作表第一列有数据的最后一行。
  • 若表头还未复制，就将当前文件的完整数据（从 A1 到 L 列最后一行）复制到目标工作表；若表头已复制，则只复制数据行（从 A2 到 L 列最后一行）。
  • 关闭当前处理的文件，继续处理下一个文件。

8. 错误处理区块

vba

OpenErrorHandler:
    MsgBox "打开工作簿 " & Filename & " 时出现错误，请检查文件是否正常。"
    Resume Next

• 功能：若在打开文件时出现错误，会弹出消息框提示用户检查文件是否正常，然后继续处理下一个文件。

9. 合并完成提示与保存新文件区块

vba

MsgBox "合并完成！"
Set newWb = Workbooks.Add
wsTarget.Copy Before:=newWb.Sheets(1)
newWb.SaveAs newFileName
newWb.Close SaveChanges:=True

• 功能 ：
  • 所有文件处理完毕后，弹出消息框提示 "合并完成！"。
  • 创建一个新的工作簿。
  • 将合并数据所在的目标工作表复制到新工作簿的第一个工作表之前。
  • 按照控制工作表中指定的文件名保存新工作簿，最后关闭新工作簿。

10. 退出宏区块

vba

Exit Sub

• 功能：正常退出宏的执行。

完整代码如下

Sub MergeExcels()
    ' 声明所有变量
    Dim folderPath As String
    Dim targetSheetName As String
    Dim wbMaster As Workbook
    Dim wsControl As Worksheet
    Dim wbB As Workbook
    Dim wsB As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim copyRowRange As Range
    Dim pasteCol As Long
    Dim pasteRow As Long
    Dim key1 As String
    Dim key2 As String
    Dim key3 As String
    Dim key4 As String
    Dim colWidth As String
    Dim rowHeight As Long
    Dim checkRow As Long
    Dim pasteRows As Long
    Dim j As Long
    Dim fileCount As Long ' 新增：用于记录合并的文件数量

    ' 1. 设置主工作簿及控制工作表
    Set wbMaster = ThisWorkbook
    Set wsControl = wbMaster.Sheets("control")

    ' 2. 获取要合并的文件夹路径及目标工作表名
    folderPath = wsControl.Range("B18").Value
    targetSheetName = "Combine"
    headerRows = wsControl.Range("B9").Value
    colWidth = wsControl.Range("D9").Value
    newFileName = wsControl.Range("B19").Value


    ' 4. 设置目标工作表，如果不存在则创建
    On Error Resume Next
    Set wsTarget = wbMaster.Sheets(targetSheetName)
    On Error GoTo 0
    If wsTarget Is Nothing Then
        Set wsTarget = wbMaster.Sheets.Add(After:=wbMaster.Sheets(wbMaster.Sheets.Count))
        wsTarget.Name = targetSheetName
    End If
    
    
    'CLEAR combine sheet content
    wsTarget.Select
    Cells.Select
    Selection.ClearContents
   
    isTitleCopy = False

    lastRow = 0 ' targer 的最后一行
       
    ' 9. 获取文件夹中的所有 Excel 文件并遍历合并
    folderPath = folderPath & "\"
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    Filename = Dir(folderPath & "*.xls*")
    fileCount = 0 ' 初始化文件数量为 0
    Do While Filename <> ""
    
        fileCount = fileCount + 1 ' 每次循环，文件数量加 1
        On Error GoTo OpenErrorHandler
        Set wbB = Workbooks.Open(folderPath & Filename)
        On Error GoTo 0
        Set wsB = wbB.Sheets(1) ' 这里假设只处理每个工作簿的第一个工作表，可按需修改

        endRowFrom = wsB.Cells(Rows.Count, 1).End(xlUp).Row
        
        copyStartRow = lastRow + 1
        
        If isTtileCopy = False Then
        
          wsB.Range("A1:L" & endRowFrom).Copy wsTarget.Range("A" & copyStartRow)
          lastRow = endRowFrom
          isTtileCopy = True
        
        Else
        
          wsB.Range("A2:L" & endRowFrom).Copy wsTarget.Range("A" & copyStartRow)
          lastRow = lastRow + endRowFrom - 1
        
        End If
 
        ' 16. 关闭当前遍历的工作簿
        wbB.Close False

        Filename = Dir
    Loop


    MsgBox "合并完成！"
    
    
    
        '创建一个新的工作簿
    Set newWb = Workbooks.Add
    
    '将原工作表复制到新工作簿
    wsTarget.Copy Before:=newWb.Sheets(1)
    
    '保存新工作簿到指定路径
    
    newWb.SaveAs newFileName
    
    '关闭新工作簿
    newWb.Close SaveChanges:=True
    
    

    Exit Sub
OpenErrorHandler:
    MsgBox "打开工作簿 " & Filename & " 时出现错误，请检查文件是否正常。"
    Resume Next
End Sub