I have a Workbook with multiple sheets, all with the same configuration, with headers on row 1 and data starting from row 2.
I want to combine the data from all the sheets into one single sheet called “Target”. I have to go through all the sheets and check what is the last row and the last column with data to define the range that I’m going to copy to the Target sheet. I think that the code is all well commented for you to understand how this is done. This is a simple example how to combine data from multiple sheets into one single sheet. This can be done other ways or can be more complex with sheets with different columns or so. This will be handled in future articles.
Sub CombineSheets()
'This macro will copy all rows from the first sheet
'(including headers)
'and on the next sheets will copy only the data
'(starting on row 2)
Dim i As Integer
Dim j As Long
Dim SheetCnt As Integer
Dim lstRow1 As Long
Dim lstRow2 As Long
Dim lstCol As Integer
Dim ws1 As Worksheet
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
On Error Resume Next
'Delete the Target Sheet on the document (in case it exists)
Sheets("Target").Delete
'Count the number of sheets on the Workbook
SheetCnt = Worksheets.Count
'Add the Target Sheet
Sheets.Add after:=Worksheets(SheetCnt)
ActiveSheet.Name = "Target"
Set ws1 = Sheets("Target")
lstRow2 = 1
'Define the row where to start copying
'(first sheet will be row 1 to include headers)
j = 1
'Combine the sheets
For i = 1 To SheetCnt
Worksheets(i).Select
'check what is the last column with data
lstCol = ActiveSheet.Cells(1, Activesheet.Columns.Count).End(xlToLeft).Column
'check what is the last row with data
lstRow1 = ActiveSheet.Cells(activesheet.rows.count, "A").End(xlUp).Row
'Define the range to copy
Range("A" & j, Cells(lstRow1, lstCol)).Select
'Copy the data
Selection.Copy
ws1.Range("A" & lstRow2).PasteSpecial
Application.CutCopyMode = False
'Define the new last row on the Target sheet
lstRow2 = ws1.Cells(65536, "A").End(xlUp).Row + 1
'Define the row where to start copying
'(2nd sheet onwards will be row 2 to only get data)
j = 2
Next
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
Sheets("Target").Select
Cells.EntireColumn.AutoFit
Range("A1").Select
End Sub
25 comentários:
Hey, thanx for sharing this script. I have exactly the same needs. The only thing is that I have to eliminate the () in the end of a command otherwise it will see it as a syntax error. The other thing is I was not able to paste it, so I had to add ws1.activate and ws1.cells(1,1).select.
Once again. Thank you for sharing the idea.
You don't need to select sheets in this code.
Never declare Rows & Columns as Integers, especially with Excel 2007 & later - you could soon run into problems exceeding the limit for an Integer - 32,767.
You need to use Set to declare a WorkSheet
I would suggest that you determine if the data has a header row & if so only copy that header row once, use Resize to remove it from subsequent copies.
Here's some simple code that can be quickly adapted. Note that by not selecting the sheets you don't really need to switch off screen updating
Option Explicit
'---------------------------------------------------------------------------------------
' Procedure : Combinedata
' Author : Roy Cox
' Website : www.excel-it.com
' Date : 10/10/2010
' Purpose : Combine data from all sheets to a master sheet
'---------------------------------------------------------------------------------------
'
Private Sub Combinedata()
Dim ws As Worksheet
Dim wsMain As Worksheet
Dim DataRng As Range
Dim Rw As Long
Dim Cnt As Integer
Cnt = 1
Set wsMain = Worksheets("Target")
wsMain.Cells.Clear
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> wsMain.Name Then
If Cnt = 1 Then
Set DataRng = ws.Cells(2, 1).CurrentRegion
DataRng.Copy wsMain.Cells(Cnt, 1)
Else: Rw = wsMain.Cells(Rows.Count, 1).End(xlUp).Row + 1
'don't copy header rows
DataRng.Offset(1, 0).Resize(DataRng.Rows.Count - 1, _
DataRng.Columns.Count).Copy ActiveSheet.Cells(Rw, 1)
End If
End If
Cnt = Cnt + 1
Next ws
End Sub
Hello Roy,
Thanks for your input on this one.
The code that was (was because I just changed it) was an old version, a "first" version of the macro that I've made for this task. The finished code is already available on the article.
Look forward for your comments on this one so that I can improve the code.
Regards,
jppinto
I'm working on a project where I need to do this - combine data on separate worksheets onto another worksheet. All worksheets have the same title row. JP, I tried your code and it worked perfectly. Roy, with the concern on declaring rows and columns and integers, I tried your code. It worked also - but not perfectly. I have 5 worksheets to combine. On the Target worksheet, I ended up with the data from worksheet 1 written 5 times instead. So an increment is dropped somewhere, and I'm not savvy enough to figure it out. Can you help?
Also, my data is dynamic - so everytime the worksheet is opened, the macro would need to run, or a button placed somewhere (e.g. an instruction worksheet) where the user can select it to run. Is there a way to identify an instruction worksheet which would get ignored in running the combine macro? thanks - all help greatly appreciated.
If my code works why do you need to debug Roy's code?
To tun the macro when you open the file, you need to put this code inside the Workbook_Open event on the "ThisWorkbook" window on the VBA editor.
WOW! Thank you Thank you! This macro worked great... and saved me many hours of work!
BTW: I noticed that if the last row(s) don't have an entry in the first column... the macro doesn't recognize all the way to the bottom.
What about running a macro from excel 2010 to combine all sheets from a 2003 workbook into 1 sheet in 2010 to get around that 65536 limit in excel 2003? When I try it only seems to stop at 65536 but I need all the sheets combined.
great code, thank you!
great code, saved me hours, thank you
Great code, thank you. I do have one issue though. My data is linked to other workbooks and this code kills the links. Anyway to maintain that?
(It's like it just copies the data from the other workbooks but doesn't maintain the link to them in case they get updated.)
I have several sheets, where each sheet is a database table name, and within the sheet are the "ColumnName, DataType, Precision, Scale". I need to copy all of the sheets to one sheet that has the sheet name (aka) table name in the first column, and the other values are pasted to the right (B through E), so I end up with one sheet that has all of the table names and column names in one workbook.
Hi,
I need to combine data from two multiple workbooks into one sheet.
Can someone help me with the code.
Thanks,
Rohit
Great code, thank you for writing this, can you tell me how to skip 2 row each time you paste from a sheet, so will have Target sheet with 2 empty rows between each sheet was copied
Great code Roy,however there is one flaw in the code :
The Statement,
'Set DataRng = ws.Cells(2,1).CurrentRegion' should come before 'If Cnt = 1 Then', otherwise it will keep on printing the 1st sheet again and again instead of selecting the cells of the next sheet.
i HAVE SHEET WHICH HAVING THE 2500 ROWS , BUT IN THESE ROW THERE IS BLANK ROWS COMES AFTER 50 DATA ROWS.
NOW I WANT TO DELETE THESE BLANK ROWS AND COMBINE THE DATA IN SEQUENCE.
NOTE: AT THE END THERE IS ONE LINE OF TOTAL ALSO WHICH I HAVE REQUIRED FOR CROSS CHECK THE DATA.
Dear JPPINTO
Your VB-code much usful, but How do I copy and paste the values in cells instead of present one which copy the formula too.
Plz reply.
What if i just want the data to be pasted into the Target Worksheet? i dont want it to be created or deleted.
Is there any simler code to combin multiple sheet one Consolidate sheet..?
i have all the sheet contains the same Headder fileds but data range will be increase.
Nice work, that helped me too !
Hi,
I dont want to copy all the sheet into the target sheet, I want copy only sheet 1 and sheet 2 to the sheet name called target and delete the duplicate rows and show the message like this many cells are combined and deleted these many duplicate rows.
Thanks,
Jagadeesh
Lê Tiêu Dao do dự một chút rồi nói.
- Lê Tiêu Dao, Nam Cung Lạc Nhan.
Dương Thiếu Phong mỉm cười:
- Tên rất đẹp, rất đẹp!
đồng tâm
game mu
cho thuê nhà trọ
cho thuê phòng trọ
nhac san cuc manh
số điện thoại tư vấn pháp luật miễn phí
văn phòng luật
tổng đài tư vấn pháp luật
dịch vụ thành lập công ty trọn gói
http://we-cooking.com/
chém gió
- Người này thật phiền toái,chúng ta đi thôi.
Nhìn thấy bộ dạng của Dương Thiếu Phong, Nam Cung Lạc Nhan và Lê Tiêu Dao đều không vui, lập tức muốn rời khỏi.
- Nhị vị tiểu thư, không bằng chúng ta cùng vào đi được không?
Thanh niên áo trắng mỉm cười một lần nữa chặn hai nữ nhân lại.
- Các hạ mau rời đi, nể mặt công hội Luyện dược sư, ta sẽ không động thủ.
Một thân ảnh hiện lên, chính là tứ trưởng lão của Cuồng Sư môn.
- Hừ, hóa ra là các ngươi biết chúng ta là người của Công hội Luyện Dược sư, vậy mà khẩu khí vẫn lớn.
Nam Tử áo trắng sững cả người, cảm nhận khí tức trên người đối phương thì thấy ba
Nice and good section. it is very useful for me to learn and endure regularly.. thanks for sharing your valuable learning and time. please keep updating.
Selenium Training in HRBR Layout
Selenium Training in Kalyan Nagar
Best Selenium Training Institute in Kalyan Nagar Bangalore
I was waiting for a post like this. Got cleared with this doubt. Thanks for sharing. Hope to see similar posts. Keep sharing.
Salesforce developer training
Thank you for excellent article.You made an article that is interesting.
Tavera car for rent in coimbatore|Indica car for rent in coimbatore|innova car for rent in coimbatore|mini bus for rent in coimbatore|tempo traveller for rent in coimbatore|kodaikanal tour package from chennai
Keep on the good work and write more article like this...
Great work !!!!Congratulations for this blog
Post a Comment