合并excel表单和工作簿，识别表单和woorkbook源代码VBA

我有多个工作簿和工作表具有相同的信息，我一直在试图合并所有这些文件标识信息源（工作表 – 工作簿）。

我已经使用这个代码，但它只是合并单元格，我不能识别信息源（工作表 – 工作簿）

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

我没有你的工作簿，所以我不能自己testing它，但是结构在那里，所以如果遇到错误，你可以很容易地debugging它：

 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