合并以名称开头的工作表 "Index"

Question

早上好，

我在找VBA代码将多个excel文件中的工作表合并到一个excel文件时遇到问题。我得到了以下VBA代码：

Sub MergeExcelFiles()
Dim fnameList, fnameCurFile As Variant
Dim countFiles, countSheets As Integer
Dim wksCurSheet As Worksheet
Dim wbkCurBook, wbkSrcBook As Workbook
fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)
If (vbBoolean <> VarType(fnameList)) Then
If (UBound(fnameList) > 0) Then
countFiles = 0
countSheets = 0
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wbkCurBook = ActiveWorkbook
For Each fnameCurFile In fnameList
countFiles = countFiles + 1
Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)
For Each wksCurSheet In wbkSrcBook.Sheets
countSheets = countSheets + 1
wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
Next
wbkSrcBook.Close SaveChanges:=False
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
End If
Else

MsgBox "No files selected", Title:="Merge Excel files"
End If
End Sub

我想要的是，我只想合并名为"的工作表；索引"；而不是合并我选择的excel文件的所有工作表。有解决方案吗？你们能帮我一下吗？

Answer 1

您有这行的地方：

wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)

更新它以添加一个条件来检查名称，如下所示：

If wksCurSheet.Name = "Index" then wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)

如果你只想让计数器在找到例如sheet时递增，请将两行都包裹在新的条件中，如下所示：

If wksCurSheet.Name = "Index" then 
countSheets = countSheets + 1
wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
End If