Hi Noorain, Thanks for the help, but it is not working at my end due to different sheet name (I believe), can we make it flexible (as it need to run in any worksheet).
Also i need my output as like below.. I am ok to repeat the heading of data And one more thing can macro ask me the range which need to select (single time) and sheets to be consolidate (as selection only once) Regards, Anil Bhange IP Phone - 512320 | Mobile - 90290 32123 From: excel-macros@googlegroups.com [mailto:excel-macros@googlegroups.com] On Behalf Of NOORAIN ANSARI Sent: Thursday, October 27, 2011 05:37 PM To: excel-macros@googlegroups.com Subject: Re: $$Excel-Macros$$ Urgent help needed Dear Anil, Please try through below code and see attached sheet. Sub Consodilated_sheet_withsheetname() Dim i, j, k, s As Long Dim x, y, z As Long Application.ScreenUpdating = False x = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column s = Sheets.Count Sheets.Add After:=Sheets(Sheets.Count) Sheets(Sheets.Count).Name = "Master Sheet" For i = 1 To s Sheets(i).Select j = 2 k = ActiveSheet.UsedRange.Rows.Count Rows(j & ":" & k).Copy Sheets(Sheets.Count).Select Sheets(Sheets.Count).Range("A65356").End(xlUp).Offset(1, 0).Select ActiveSheet.Paste ActiveCell.Offset(0, x) = Sheets(i).Name ActiveCell.Offset(0, x).EntireRow.Interior.Color = vbCyan Next i Application.ScreenUpdating = True End Sub On Thu, Oct 27, 2011 at 3:54 PM, Anil Bhange <anil.bha...@tatacommunications.com<mailto:anil.bha...@tatacommunications.com>> wrote: Hi Expert, I have found one code which can consolidate the excel worksheets into one worksheet, but I wanted my worksheet name should also appear after consolidation in column. I am unable to make changes in this code, please help me urgently, Sub CopyFromWorksheets() Dim wrk As Workbook 'Workbook object - Always good to work with object variables Dim sht As Worksheet 'Object for handling worksheets in loop Dim trg As Worksheet 'Master Worksheet Dim rng As Range 'Range object Dim colCount As Integer 'Column count in tables in the worksheets Set wrk = ActiveWorkbook 'Working in active workbook For Each sht In wrk.Worksheets If sht.Name = "Master" Then MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _ "Please remove or rename this worksheet since 'Master' would be" & _ "the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error" Exit Sub End If Next sht 'We don't want screen updating Application.ScreenUpdating = False 'Add new worksheet as the last worksheet Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count)) 'Rename the new worksheet trg.Name = "Master" 'Get column headers from the first worksheet 'Column count first Set sht = wrk.Worksheets(1) colCount = sht.Cells(1, 255).End(xlToLeft).Column 'Now retrieve headers, no copy&paste needed With trg.Cells(1, 1).Resize(1, colCount) .Value = sht.Cells(1, 100).Resize(1, colCount).Value 'Set font as bold .Font.Bold = True End With 'We can start loop For Each sht In wrk.Worksheets 'If worksheet in loop is the last one, stop execution (it is Master worksheet) If sht.Index = wrk.Worksheets.Count Then Exit For End If 'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount)) 'Put data into the Master worksheet trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value Next sht 'Fit the columns in Master worksheet trg.Columns.AutoFit 'Screen updating should be activated Application.ScreenUpdating = True End Sub Anil Bhange Assistant Manager Financial Reporting & Compliance, TATA Communications Ltd. VSB, Fort, Mumbai - 400 001, India ' Desk : + 91 22 6659 2320 | IP Phone : 51 2320 | Mobile :+ 91 90290 32123 anil.bha...@tatacommunications.com<mailto:anil.bha...@tatacommunications.com> -- ---------------------------------------------------------------------------------- Some important links for excel users: 1. Follow us on TWITTER for tips tricks and links : http://twitter.com/exceldailytip 2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310 3. Excel tutorials at http://www.excel-macros.blogspot.com<http://www.excel-macros.blogspot.com/> 4. Learn VBA Macros at http://www.quickvba.blogspot.com<http://www.quickvba.blogspot.com/> 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com<http://exceldailytip.blogspot.com/> To post to this group, send email to excel-macros@googlegroups.com<mailto:excel-macros@googlegroups.com> <><><><><><><><><><><><><><><><><><><><><><> Like our page on facebook , Just follow below link http://www.facebook.com/discussexcel -- Thanks & regards, Noorain Ansari http://excelmacroworld.blogspot.com/ http://noorain-ansari.blogspot.com/ -- ---------------------------------------------------------------------------------- Some important links for excel users: 1. Follow us on TWITTER for tips tricks and links : http://twitter.com/exceldailytip 2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310 3. Excel tutorials at http://www.excel-macros.blogspot.com 4. Learn VBA Macros at http://www.quickvba.blogspot.com 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com To post to this group, send email to excel-macros@googlegroups.com<mailto:excel-macros@googlegroups.com> <><><><><><><><><><><><><><><><><><><><><><> Like our page on facebook , Just follow below link http://www.facebook.com/discussexcel -- ---------------------------------------------------------------------------------- Some important links for excel users: 1. Follow us on TWITTER for tips tricks and links : http://twitter.com/exceldailytip 2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310 3. Excel tutorials at http://www.excel-macros.blogspot.com 4. Learn VBA Macros at http://www.quickvba.blogspot.com 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com To post to this group, send email to excel-macros@googlegroups.com <><><><><><><><><><><><><><><><><><><><><><> Like our page on facebook , Just follow below link http://www.facebook.com/discussexcel
