| Home |
| Search |
| Today's Posts |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
A macro to make a summary sheet
OK
-- Regards Ron de Bruin http://www.rondebruin.nl "ADK" wrote in message ... Can I send you the xls file? "Ron de Bruin" wrote in message ... Hi ADK Copy the function LastRow also from that webpage into your module -- Regards Ron de Bruin http://www.rondebruin.nl "ADK" wrote in message ... I tried but I receive a Compile Error Sub or function not defined and it highlights LastRow Here is what the code is: Sub Summary() Dim sh As Worksheet Dim DestSh As Worksheet Dim shLast As Long Dim Last As Long On Error Resume Next If Len(ActiveWorkbook.Worksheets.Item("Master").Name) = 0 Then On Error GoTo 0 Application.ScreenUpdating = False Set DestSh = ActiveWorkbook.Worksheets.Add DestSh.Name = "Master" For Each sh In ActiveWorkbook.Worksheets If sh.Name < DestSh.Name Then Last = LastRow(DestSh) shLast = LastRow(sh) 'sh.Range(sh.Rows(3), sh.Rows(shLast)).Copy DestSh.Cells(Last + 1, "A") 'Instead of this line you can use the code below to copy only the values 'or use the PasteSpecial option to paste the format also. 'With sh.Range(sh.Rows(3), sh.Rows(shLast)) 'DestSh.Cells(Last + 1, "A").Resize(.Rows.Count, _ '.Columns.Count).Value = .Value 'End With sh.Range(sh.Rows(3), sh.Rows(shLast)).Copy With DestSh.Cells(Last + 1, "A") .PasteSpecial xlPasteValues, , False, False .PasteSpecial xlPasteFormats, , False, False Application.CutCopyMode = False End With End If Next DestSh.Cells(1).Select Application.ScreenUpdating = True Else MsgBox "The sheet Master already exist" End If End Sub "Ron de Bruin" wrote in message ... Hi ADK Try http://www.rondebruin.nl/copy2.htm -- Regards Ron de Bruin http://www.rondebruin.nl "ADK" wrote in message ... I have an Excel file which has various sheets (departments) which have a list of drawings associated with that department. I would like to take the lists from each sheet and make a master summary list of drawings. Sometimes a department will have more or less drawings per project. The number of rows in each department vary and can change throughout the project. I would like a macro that goes to each sheet and within a set maximum range, select those rows which are NOT empty and copy the values to the summary sheet ...then the next sheet values would follow on the summary sheet. It would also be nice if it would insert the department name at the top of each list (that cell is: A1). Hopefully I explained that well. We have another spreadsheet with a macro that does something like that but have no idea how it works and how to modify it to suit my spreadsheet. The maximum range is: A3:D86 My sheets a General Arrangement of Equipment DWGS Structural Steel DWGS Arrangement of Piping DWGS Pipe Supports Isometric Piping Spools Insulation & Heat Trace Dwgs Instrumentation Drawings Electrical Drawings Shipping and Rigging Reference Drawings Here is the code (which is assign to a button) from the sample spreadsheet: ' ' Select a range ' Sub selectrange() Dim rowcoord As Single Dim putcoord As Single Dim shtnumber As Single Dim x As Single Application.CutCopyMode = False Worksheets("Summary").Activate Rows("3:750").Select Selection.Delete Shift:=xlUp Range("B3").Select shtnumber = 1 putcoord = 2 Do For x = 1 To shtnumber ActiveSheet.Next.Select Next If Application.ActiveSheet.Name = "Autocad Colors" Then Exit Do End If rowcoord = 2 Do If (Range("A1").Offset(rowcoord, 1) = "") And (Range("A1").Offset(rowcoord + 1, 1) = "") Then Exit Do Else rowcoord = rowcoord + 1 End If Loop Range(Range("A1").Offset(1, 1), Range("A1").Offset(rowcoord - 1, 14)).Select Selection.Copy Worksheets("Summary").Activate Do If (Range("A1").Offset(putcoord, 1) = "") And (Range("A1").Offset(putcoord + 1, 1) = "") Then Exit Do Else putcoord = putcoord + 1 End If Loop putcoord = putcoord + 2 Range("A1").Offset(putcoord, 1).Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False shtnumber = shtnumber + 1 Loop Worksheets("Summary").Activate For x = 1 To shtnumber ActiveSheet.Next.Select Range("B3").Select Next Worksheets("Summary").Activate Range("B3").Select End Sub |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Make all values of a 3D named range appear on summary sheet | Excel Discussion (Misc queries) | |||
| Summary Sheet Macro | Excel Discussion (Misc queries) | |||
| how do you make a summary page showing the workbook name with the excel sheet names | New Users to Excel | |||
| Can I make a list, on one summary sheet, of data collected from ma | Excel Worksheet Functions | |||
| macro to make different tabs in a same sheet | Excel Programming | |||
Threaded Mode
