Dear Andy, Try the following code.
Public Sub CombineWorksheets() ' ' This routine assumes that ALL worksheets have the same field structure; ' same column headings, and the same column order. The code copies all ' rows into a new worksheet called "Combined". ' Dim wrk As Workbook ' Workbook object Dim sht As Worksheet ' Object for handling worksheets in loop Dim trg As Worksheet ' Combined 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 = "Combined" Then MsgBox "There is already a worksheet named 'Combined'." & vbCrLf & _ "Please remove or rename this worksheet.", vbOKOnly + vbExclamation, "Error" Exit Sub End If Next sht Application.ScreenUpdating = False ' Disable screen updating ' Add "Combined" worksheet as the last worksheet Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count)) trg.Name = "Combined" ' Get column headers from the first worksheet Set sht = wrk.Worksheets(1) ' Get Column count colCount = sht.Cells(1, 255).End(xlToLeft).Column With trg.Cells(1, 1).Resize(1, colCount) ' retrieve headers .Value = sht.Cells(1, 1).Resize(1, colCount).Value .Font.Bold = True End With For Each sht In wrk.Worksheets ' If this worksheet is the last one, stop execution If sht.Index = wrk.Worksheets.Count Then Exit For End If ' Data range begins with second row 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 trg.Columns.AutoFit ' Fit the columns in Master worksheet Application.ScreenUpdating = True ' Enable screen updating End Sub Thanks & regards, || Mudassar Ramzan | MIS Officer | WorldCALL Telecom Ltd | 061- 814-3999 | 0321 7325277 || ----- Original Message ----- From: Aindril De To: excel-macros@googlegroups.com Sent: Thursday, April 02, 2009 8:02 PM Subject: $$Excel-Macros$$ Re: Help with Nested For Loop Hi Sathish, Thanks a lot for the help. This shd work with the name of the sheets like Sheet1 Sheet2 etc and that too if the names are missing like for e.g Sheet3 is missing and you have Sheet 4 after Sheet 2 then it will not work correctly... However what I want is any name of the sheet can make the code work. and also it shd copy the first header row from the first sheet. Hope it explains the problem more. regards, Andy On Thu, Apr 2, 2009 at 4:25 PM, Aindril De <aind...@gmail.com> wrote: Hi All, I am trying to write a Macro to do the following: It will Count the number of sheets in the workbook and then copy the contents of all the sheets into a sheet called "Results". Following is the code that I have written. But the problem is the Nested For Loop is not working. Once it enters in the inner loop, it never comes out of the innet loop and hence the macro execution ends. Sub copyRows_1() Dim SiteCol As Range, Cell As Object, SheetCount As Long, m As Long Application.Volatile SheetCount = Sheets.Count For m = 1 To SheetCount - 1 Sheets(m).Activate MsgBox "Copying From Sheet " & ActiveSheet.Name Set SiteCol = Range("A1:A700") For Each Cell In SiteCol If IsEmpty(Cell) Then Exit Sub End If Cell.EntireRow.Copy Sheets("Results").Activate ActiveSheet.Range("A65536").End(xlUp).Select Selection.Offset(1, 0).Select ActiveSheet.Paste Next Cell Next m End Sub Need help in arranging the FOR loop properly! Thanks in Advance Andy --~--~---------~--~----~------------~-------~--~----~ ------------------------------------------------------------------------------------- Some important links for excel users: 1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at http://www.excelitems.com 2. Excel tutorials at http://www.excel-macros.blogspot.com 3. Learn VBA Macros at http://www.vbamacros.blogspot.com 4. Excel Tips and Tricks at http://exceldailytip.blogspot.com To post to this group, send email to excel-macros@googlegroups.com If you find any spam message in the group, please send an email to: Ayush Jain @ jainayus...@gmail.com or Ashish Jain @ 26may.1...@gmail.com ------------------------------------------------------------------------------------- -~----------~----~----~----~------~----~------~--~---