VBA 表格操作2 表格復制

office excel文件有工作簿，里面存放一張張表，表的名字叫做標簽名，簿名就是我們常見的的文件名，簿的類型有“一簿一表”與“一簿多表”。
完成將多張表合並到一個工作簿中，並為表標簽命名，增加制表日期。

簿與簿直接的操作基本如下：

1.一簿一表之間的復制 一對一
2.多個一簿一表的合並
3.多個一簿多表與一簿一表的合並

現在在目錄下新建文件夾test，並在里面新建2個一簿3表的excel文件li1,li2,其中li1中3張表的標簽分別為a\b\c,li2中表的標簽分別為1、2、3，1個一簿1表的excel文件li0,表標簽為0.
如圖所示

一簿一表之間的復制

Sub 一簿一表之間的復制
Application.ScreenUpdating = F

Dim wb As Workbook

    filename = "C:\Users\liyi\Desktop\test" & "\li1.xlsx"
    Set wb = Workbooks.Add
    
    Dim tempwb As Workbook
    
    Set tempwb = GetObject(filename)
    
        tempwb.Worksheets(1).Copy before:=wb.Worksheets(wb.Worksheets.Count)
        wb.SaveAs ThisWorkbook.Path & "\一簿一表之間的復制.xlsx"
        wb.Close
End Sub

這樣就把li1中的表a,復制到新建的表中，並插在默認第一張表之前。
結果如圖

多個一簿一表之間的合並

Sub 多個一簿一表的合並()
Application.ScreenUpdating = F

Dim wb As Workbook, filename As String

    filename = Dir("C:\Users\liyi\Desktop\test" & "\li*.xlsx")  ' dir函數遍歷文件，並將文件名賦值給filename
    Set wb = Workbooks.Add
    
    Dim tempwb As Workbook, fn As String
    Do While filename <> ""
    fn = "C:\Users\liyi\Desktop\test" & "\" & filename   '將文件路徑賦值給fn
    Set tempwb = GetObject(fn)                           '獲取到該文件
        tempwb.Worksheets(1).Copy before:=wb.Worksheets(wb.Worksheets.Count)
        ActiveSheet.Name = Left(filename, Len(filename) - 5) & "_" & tempwb.Worksheets(1).Name
        '以工作簿的名字加上"_"加上表標簽為新簿中的表命名
    
        filename = Dir
        Loop
        Application.DisplayAlerts = False  '“刪除工作表警告提示” 取消
        Sheets("sheet1").Delete            '刪除新建簿時默認生成的sheet1
        Application.DisplayAlerts = True
        wb.SaveAs ThisWorkbook.Path & "\多個一簿一表的合並.xlsx"
        wb.Close
 
End Sub

新簿是將3個文件中的第一張表復制到新簿，並重新命名
結果如圖：

多個一簿多表的合並

Sub 多個一簿多表的合並()
Application.ScreenUpdating = F

Dim wb As Workbook, filename As String, fn As String


    filename = Dir("C:\Users\liyi\Desktop\test" & "\li*.xlsx")
    Set wb = Workbooks.Add
    
    Dim tempwb As Workbook
    Do While filename <> ""
       fn = "C:\Users\liyi\Desktop\test" & "\" & filename
        Set tempwb = GetObject(fn)
            Dim sht As Worksheet
            For Each sht In tempwb.Worksheets
            sht.Copy before:=wb.Worksheets(wb.Worksheets.Count)
             ActiveSheet.Name = Left(filename, Len(filename) - 5) & "_" & sht.Name
           
            Next
        
        filename = Dir
    Loop
        Application.DisplayAlerts = False  '“刪除工作表警告提示” 取消
        Sheets("sheet1").Delete
        Application.DisplayAlerts = True
        yue = Month(Date - 1)
        ri = Day(Date - 1)
        
        wb.SaveAs ThisWorkbook.Path & "\多個一簿多表的合並()" & yue & ri & ".xlsx"
        wb.Close
 
End Sub

結果如圖