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