Should it look like what is below? When I copied and pasted it, this is the
code that I have, and it didn't work right.. not sure why not though.

Private Sub MoveRow_Click()
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



"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