1。 激活要组合其所有工作表的工作簿，然后按 + 键打开 Microsoft Visual Basic for Applications 窗口。
2。 在弹出窗口中，单击 插页 > 模块 创建一个新的模块脚本。
Sub Combine（）'UpdatebyExtendoffice Dim J As Integer On Error Resume Next Sheets（1）.Select Worksheets.Add Sheets（1）.Name =“Combined”Sheets（2）.Activate Range（“A1”）。EntireRow.Select Selection .Copy Destination：= Sheets（1）.Range（“A1”）For J = 2 To Sheets.Count Sheets（J）.Activate Range（“A1”）。选择Selection.CurrentRegion.Select Selection.Offset（1，0） ）.Resize（Selection.Rows.Count - 1）.Select Selection.Copy Destination：= Sheets（1）.Range（“A65536”）。End（xlUp）（2）Next End Sub
Yes, the code only can keep first row of the first tab, because it is used to consolidate, if you want to keep all contents of each sheet, you can try Combine utility of Kutools for Excel, it is free fior 60 days
Hello, elok, did the problem appear while you applying Combine function? If so, please go to contact us email@example.com to describe the problem with more details, our support will handle the problem for you.
Thanks that macro saved my day. I had over 40 sheets of data to combine into one and although my computer bogged for a minute or two, it completed without issue. The only modification I made was I tweaked the macro to start with A2 instead of A1 since A1 was my column headers.
I have used the below mentioned code, In my data some blank Rows is there for each tab. Data is not coping after the blank rows. How to combine the all data after the blank rows. Please advise.
Dim J As Integer
On Error Resume Next
Sheets(1).Name = "Combined"
For J = 2 To Sheets.Count
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
You can try below code, it will merge all data and skip blank rows.
Dim xI, xMax As Integer
Dim xCWS, xWS As Worksheet
Dim xObjRRange, xObjCRange, xObjSR As Range
On Error Resume Next
Set xCWS = Worksheets.Add
xCWS.Name = "Combined"
For xI = 2 To Sheets.Count
Set xWS = Sheets(xI)
Set xObjRRange = xWS.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
Set xObjCRange = xWS.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
Set xObjSR = Range(Cells(1, 1), Cells(xObjRRange.Row, xObjCRange.Column))
xMax = xCWS.Range("a65536").End(3).Row
xCWS.Range("a1:a" & xMax).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
The below code will combine sheets from the second row, you can change the number 2 (xStart = 2) to other number for you need.
Dim xStart, xFNum, xIntCFMax, xIntRRg, xIntCRg As Integer
Dim xCFWS, xWS As Worksheet
Dim xObjSR As Range
Dim xStrName As String
On Error Resume Next
Application.ScreenUpdating = False
xStart = 2
xStrName = "CombinedForm"
Set xWS = Sheets(xStrName)
If xWS Is Nothing Then
Set xCFWS = Worksheets.Add
xCFWS.Name = xStrName
For xFNum = 1 To Sheets.Count
Set xWS = Sheets(xFNum)
If xWS.Name <> xStrName Then
xIntRRg = xWS.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
xIntCRg = xWS.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
If xStart <= xIntRRg Then
Set xObjSR = Range(Cells(xStart, 1), Cells(xIntRRg, xIntCRg))
Application.ScreenUpdating = True
My headings start on row 26, the first 25 rows are occupied with the parameters I used to generate my reports, it would take a long time to delete these since there are many reports generated. Using the VBA code above, how could I configure this code to exclude the first 25 rows, capture the headings on row 26 and combine all the data under the headings (row 27 onwards) for each worksheet?
First of all I have to tell that I have no experience with Macro (VBA Codes). However what I need is related to this. Maybe you guys could help me with it.
I have a workbook and in this workbook there are 10 worksheets. The first 9 Sheets have the same order of the coloumns of titles and in these columns there are names, dates, percentages of Project Status, comments to Projects etc.. As I said the columns have the same order just the name of the worksheets (for different Teams in the Organisation) are different.
In Addition to this I have to merge all the worksheets and have them in another sheet which is called "Übersicht" (Overview). However there is a different column in the sheet and it's between "Nr." and "Thema" columns (which are in A1 and A2 in all the 9 Sheets) and this different column called "Kategorie" (in A2 in Übersicht-Overwiev sheet). As this column is between These the order is like this "Nr. (A1), Kategorie (A2) and Thema (A3).....".So this category column (Kategorie) should be empty except this all the Information should be merged into this sheet. And also when there is a Change or update in any worksheet, the Information in "Übersicht" (Overview) sheet needs to update by itself. How can I do this?
P.S.: Every sheet has different filled rows, some 30, some 13, some 5 etc. And the Teams which are responsible for the Sheets can add or delete some rows (in each row there is different Information for different Projects). This also means the number of rows can increase or decrease.
I hope I explained it well. Thanks a lot in advance!
I need your support. I have three sheets (A, B, C) into a worksheet. the sheet contain information on individuals.
Sheet A: contains all individuals considered as ID with information (age, education, etc...)
Sheets B et C: contain some individuals (ID) with information (Organisation, income, etc...)
So I want to combine B and C to A to get all information from A,B, C together.
This code works for the most part - however, the first line of each sheet (except for the first sheet) is not extracted into the combined sheet. Which piece of the code should be modified to ensure extraction of the first line?
Attempted VBA Code. Have 5 worksheets in 2 workbook that need to be combined. All same structure. VBA code will only combine 2 of the worksheets rather than all 5. What do I change in the VBA code to make combine all 5 worksheets? Data in worksheets is all under the 65K .xls row limit and I am using Excel 2016.
I receive spreadsheets where table header is in starts in row 3. So I need to go to each worksheet to delete columns 1 and 2 for the macro to work. Can I adjust the code, so it would start in A3 instead of A1
Hi! Can you help me with this problem. I have an excel doc with 12 sheets. In each sheet is a table. With a differend cells format (width & height). I have to copy all sheets in one and save each cells format. Thanks!
Your macro worked BUT it added each sheet multiple times. i have no idea why...I had 4 sheets with invoice lists (1 septembers, 2 octobers Ect.) and for some reason it added my september back on 2 more times and added eachother one underneath 3x each.... I did not modify or delete anything from the macro just simply copied pasted and ran it...
For those people who want to update data they already merged you can use this code:
Sub Combine() Dim J As Integer On Error Resume Next 'Delete the sheet "Combined" if it exist Application.DisplayAlerts = False On Error Resume Next ActiveWorkbook.Worksheets("Combined").Delete On Error GoTo 0 Application.DisplayAlerts = True
Sheets(1).Select Worksheets.Add Sheets(1).Name = "Combined" Sheets(2).Activate Range("A1").EntireRow.Select Selection.Copy Destination:=Sheets(1).Range("A1") For J = 2 To Sheets.Count Sheets(J).Activate Range("A1").Select Selection.CurrentRegion.Select Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2) Next End Sub
I am using the VBA below with great effect with all the sheets in workbook but now I am trying to exclude one sheet name " OAL Index" and just cant seemed to get it right. It keeps selecting all the sheets
Any points to the right direction would be appreciated.
Sub Combine() Dim J As Integer
On Error Resume Next Sheets(1).Select Worksheets.Add ' add a sheet in first place Sheets(1).Name = "Combined"
For J = 2 To Sheets.Count ' from sheet 2 to last sheet If Sheets(J).Name "OAL Index" Then Sheets(J).Select Replace:=False Sheets(J).Activate ' make the sheet active Sheets(J).Select Range("A1").Select Selection.CurrentRegion.Select ' select all cells in this sheets
' select all lines except title Selection.Offset(2, 0).Resize(Selection.Rows.Count - 1).Select
' copy cells selected in the new sheet on last line Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2) Next End Sub
This worked great, saved me a lot of time, but it only merged up to column J and I need it to go up to column T. Can someone please help??? This is for my job!! Please help me not look dumb in front of my boss, thanks