Bruce,


Sub detailloop()
Dim Crows As Long
Range("rowsum").Value = 1
Sheets("Import").Select
Crows = Cells(1, 1).End(xlDown).Row

We rarely if ever need to Select. Better still to define worksheet
variables, and use those
Dim wsImport As WorkSheet
Dim wsData As Worksheet
Dim seaport as Worksheet

Set wsImport = Worksheets("Import")
Set wsData = WorkSheets("Data_Assembly").
Set wsReport = Worksheets("Report")

cRows = wsImport.Cells(1, 1).End(xlDown).Row

For i = 1 To Crows - 1
Sheets("Data_Assembly").Select
Range("Workarea").Select
ActiveCell.Value = Range("Detailloop").Offset(0, 0)
ActiveCell.Offset(1, 0).Value =
Range("Detailloop").Offset(1, 0)
ActiveCell.Offset(2, 0).Value =
Range("Detailloop").Offset(2, 0)
ActiveCell.Offset(3, 0).Value =

And so on like this through the 13th offset then I do a
check of a True false range in the if statement below:

For i = 1 to cRows -1
For j = 0 to 13
wsData.Range("Workarea").Offset(j,0).Value =
Range("Detailloop").Offset(j, 0)
Next j

If Range("Do_lse_use") Then
ActiveCell.Offset(14, 0).Value =
Range("lease_use").Offset(0, 0)
ActiveCell.Offset(15, 0).Value =
Range("lease_use").Offset(1, 0)

This part goes on till the offset in range "lease use" is
at 13.

If Range("Do_lse_use") Then
For j = 0 to 13
wsData.Range("Workarea").Offset(j+14,0).Value =
Range("lease_use").Offset(j, 0)
Next j


Else
GoTo copyrecords
End If
copyrecords:
Range(ActiveCell, ActiveCell.End(xlDown)).Copy
Sheets("Report").Select
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveCell.PasteSpecial xlPasteValues

wsData.Range("Workarea").Cells(1,1).End(xlDown).co py
wsReport.Range("A1").End(xlDown).Offset(1,0).Paste Special
xlPasteValues

Worksheets("Data_Assembly").Select
Range("Workarea").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Clear

wsData.Range("WorkArea").Cells(1,1).End(xlDown).Cl ear

Range("Row").Value = Range("Row").Value + 1
If Range("New_Prmo") Then
Range("rowsum").Value = Range("Rowsum").Value + 1
Call summonth
Else
End If
Next
End Sub


HTH

Bob

To quote Ken Wright:

"Select is bad, select is no good, select is evil!!!"

"Bob Phillips" wrote in message
...
| Bruce,
|
|
| Sub detailloop()
| Dim Crows As Long
| Range("rowsum").Value = 1
| Sheets("Import").Select
| Crows = Cells(1, 1).End(xlDown).Row
|
| We rarely if ever need to Select. Better still to define worksheet
| variables, and use those
| Dim wsImport As WorkSheet
| Dim wsData As Worksheet
| Dim seaport as Worksheet
|
| Set wsImport = Worksheets("Import")
| Set wsData = WorkSheets("Data_Assembly").
| Set wsReport = Worksheets("Report")
|
| cRows = wsImport.Cells(1, 1).End(xlDown).Row
|
| For i = 1 To Crows - 1
| Sheets("Data_Assembly").Select
| Range("Workarea").Select
| ActiveCell.Value = Range("Detailloop").Offset(0, 0)
| ActiveCell.Offset(1, 0).Value =
| Range("Detailloop").Offset(1, 0)
| ActiveCell.Offset(2, 0).Value =
| Range("Detailloop").Offset(2, 0)
| ActiveCell.Offset(3, 0).Value =
|
| And so on like this through the 13th offset then I do a
| check of a True false range in the if statement below:
|
| For i = 1 to cRows -1
| For j = 0 to 13
| wsData.Range("Workarea").Offset(j,0).Value =
| Range("Detailloop").Offset(j, 0)
| Next j
|
| If Range("Do_lse_use") Then
| ActiveCell.Offset(14, 0).Value =
| Range("lease_use").Offset(0, 0)
| ActiveCell.Offset(15, 0).Value =
| Range("lease_use").Offset(1, 0)
|
| This part goes on till the offset in range "lease use" is
| at 13.
|
| If Range("Do_lse_use") Then
| For j = 0 to 13
| wsData.Range("Workarea").Offset(j+14,0).Value =
| Range("lease_use").Offset(j, 0)
| Next j
|
|
| Else
| GoTo copyrecords
| End If
| copyrecords:
| Range(ActiveCell, ActiveCell.End(xlDown)).Copy
| Sheets("Report").Select
| Range("A1").End(xlDown).Offset(1, 0).Select
| ActiveCell.PasteSpecial xlPasteValues
|
| wsData.Range("Workarea").Cells(1,1).End(xlDown).co py
| wsReport.Range("A1").End(xlDown).Offset(1,0).Paste Special
| xlPasteValues
|
| Worksheets("Data_Assembly").Select
| Range("Workarea").Select
| Range(ActiveCell, ActiveCell.End(xlDown)).Clear
|
| wsData.Range("WorkArea").Cells(1,1).End(xlDown).Cl ear
|
| Range("Row").Value = Range("Row").Value + 1
| If Range("New_Prmo") Then
| Range("rowsum").Value = Range("Rowsum").Value + 1
| Call summonth
| Else
| End If
| Next
| End Sub
|
|
| HTH
|
| Bob
|
|