You know what? I think I did something thinking that it wouldnt make much
difference, however, it is making a difference in the code... For simplicity
sake, I just told you that my section titles were "Well Type 1 Information",
"Well Type 2 Information" and "Well Type 3 Information". The actual names of
my sections are: "Well Name", "Exploratory Wells", and "Upcoming Notables".
I believe that's making a difference in the code, other than just changing
the names... am I correct?

"Chip" wrote:

> Give this a shot:
>
> Sub Copier()
> Dim currentcell As Integer
> currentcell = ActiveCell.Row
> currentcolumn = ActiveCell.Column
>
> Range("A1").Select
> Dim Titler As String
>
> 'Find rows of titles.
>
>
>
> For i = 3 To 1 Step -1
> Titler = "WELL TYPE " & i & " INFORMATION"
>
> Cells.Find(What:=Titler, After:=ActiveCell, LookIn:=xlFormulas,
> LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
> MatchCase:=False).Activate
> Dim intcounter As Integer
> intcounter = ActiveCell.Row
>
> If currentcell > intcounter Then
> sectionnumber = i
> i = 1
> Else
> End If
>
> Next i
>
> Cells(currentcell, currentcolumn).Select
> ActiveCell.EntireRow.Copy
> Worksheets("Tracking").Activate 'the other sheet
> Titler = "WELL TYPE " & sectionnumber & " INFORMATION"
> Cells.Find(What:=Titler, After:=ActiveCell, LookIn:=xlFormulas,
> LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
> MatchCase:=False).Activate
> ActiveCell.Offset(1, 0).Select
>
> Selection.Insert Shift:=xlDown
> Worksheets("Western").Activate 'back to the original
> ActiveCell.EntireRow.Delete Shift:=xlShiftUp
>
>
> End Sub
>
>