将多个Excel workbook的同名称sheet页（比如sheet也名称为"其他流动资产"）合并到一个workbook中

sheet_merge.vb

Sub HB()
     '定义对话框变量
     Dim fd As FileDialog
     Set fd = Application.FileDialog(msoFileDialogFilePicker)
     
     
     '新建一个工作簿
     Dim newwb As Workbook
     
     Set newwb = ThisWorkbook
     
     With fd
         If .Show = -1 Then
             '定义单个文件变量
             Dim vrtSelectedItem As Variant
             
             '定义循环变量
             Dim i As Integer
             
             i = 1
             
             '开始文件检索
             For Each vrtSelectedItem In .SelectedItems
                 '打开被合并工作簿
                 Dim tempwb As Workbook

                 Set tempwb = Workbooks.Open(vrtSelectedItem, 0)
                
                 '复制工作表
                 tempwb.Worksheets("其他流动资产").Select
                
                 Cells.Select
                 
                 Selection.Copy
                 
                 Windows("抽表新宏.xlsm").Activate
                 
                 Sheets.Add After:=Sheets(Sheets.Count)
                                  
                 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                 
                 Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
                 ThisWorkbook.Sheets(Sheets.Count).Name = VBA.Replace(tempwb.Name, ".xlsx", "")

                 Application.CutCopyMode = False
                 
                 Application.AskToUpdateLinks = False
                 
                 tempwb.Close SaveChanges:=False
               
                 i = i + 1
                 
             Next vrtSelectedItem
             
         End If
         
     End With
     
     Set fd = Nothing
     
 End Sub