A macro to make a summary sheet
 

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

A macro to make a summary sheet
 

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

A macro to make a summary sheet
 

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

A macro to make a summary sheet
 

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

A macro to make a summary sheet
 

also, I can not find in your examples where you can keep it within a
selected range on each sheet (A3:D86). It seems to me that these examples
will copy all rows with data ...which there are rows I wish to omit.



"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

A macro to make a summary sheet
 

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

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