合併excel表和工作簿識別表和woorkbook源VBA

Question

我有多個工作簿和工作表具有相同的信息，我一直試圖合併所有這些文件標識信息源（工作表 - 工作簿）。

我用這個代碼，但它只是合併的單元格，我不能確定信息源（工作表 - 練習冊）

Sub merge() 
Application.DisplayAlerts = False 
For Each hoja In ActiveWorkbook.Sheets 
If hoja.Name = "todas" Then hoja.Delete 
Next 
Sheets.Add before:=Sheets(1) 
ActiveSheet.Name = "todas" 
For x = 2 To Sheets.Count 
Sheets(x).Select 
Range("a1:o" & Range("a650000").End(xlUp).Row).Copy 
Sheets("todas").Range("a650000").End(xlUp).Offset(1, 0).PasteSpecial 
Paste:=xlValues 
Next 
Sheets("todas").Select 
End Sub  

這是圖書館之一，我必須合併：

Answer 1

我沒有工作簿，所以我無法測試它自己，但結構是存在的，所以如果你遇到了一個錯誤，你可以很容易地進行調試：

Sub merge() 
    Dim rng As Range 
    Dim cell As Range 
    Application.DisplayAlerts = False 
    For Each hoja In ActiveWorkbook.Sheets 
    If hoja.Name = "todas" Then hoja.Delete 
    Next 
    Sheets.Add before:=Sheets(1) 
    ActiveSheet.Name = "todas" 

    For x = 2 To Sheets.Count 
     Set rng = Sheets(x).UsedRange 
     rng.Copy 

     'Cell in column A after the last row 
     Set cell = Sheets("todas").Range("a650000").End(xlUp).Offset(1, 0) 
     cell.PasteSpecial Paste:=xlValues 

     'Define the range that just got pasted (only column A) 
     Set rng = cell.Resize(rng.Rows.Count, 1) 

     'Offset it to the column next to the last column 
     Set rng = rng.Offset(0, rng.Columns.Count) 

     rng.Value = Sheets(x).Name 'paste the name ofthe sheet in each row 
     Set rng = rng.Offset(0, 1) 
     rng.Value = Sheets(x).Parent.Name 'paste the name of the workbook in each row 

    Next 
    Sheets("todas").Select 
    Application.DisplayAlerts = True 
End Sub