[英]Merge excel sheets and workbooks identifying the sheet and workbook source VBA
I have multiple workbooks and worksheets with the same information, I've been trying to merge all this files identifying the information source (Worksheet - workbook). 我有多个具有相同信息的工作簿和工作表,我一直试图合并所有标识信息源的文件(工作表-工作簿)。
I've used this code but it just merge the cells and I could not identify the information source (worksheet - Workbook) 我已经使用了这段代码,但是它只是合并了单元格,所以我无法识别信息源(工作表-工作簿)
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
This is one of the libraries I have to merge: 这是我必须合并的库之一:
I did not have your workbook so I could not test it myself, but the structure is there so you can debug it easily if you ran into an error: 我没有您的工作簿,所以我自己无法测试它,但是结构在那里,因此如果遇到错误,可以轻松调试它:
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.