HELP Copy And Paste

[stacia]

I am trying to copy a range of cells and paste them after every Total
This is what I have so far:

Sub b8pastetitle()

Dim theRange As Range
Dim lastrow&, firstRow&, x&
Set theRange = ActiveSheet.UsedRange
lastrow = theRange.Cells(theRange.Cells.Count).Row
firstRow = theRange.Cells(1).Row
For x = lastrow To firstRow Step -1
If InStr(1, Cells(x, 1), "Total") > 0 Then
Range("A5 : G7").Select
Selection.Copy
ActiveSheet.Paste Destination:=Worksheets("Payroll").Cells(x + 2,
1).Selection.Paste

End If
Next
End Sub

 

[Don Guillett]

selections aren't necessary. In fact, it would be easier to use
Data>filter>autofilter>filter on the column for total>copy>paste to other
sheet. Record a macro while doing and then clean up to remove the
selections. Post back with your efforts for further assistance

 

[stacia]

I guess I don't understand your reasoning. I want to copy A3:G7 after every
subtotal on same worksheet.

 

[stacia]

I don't understand your reasoning. I am trying to copy range A3:G7 after
every subtotal on the same page.

 

[Don Guillett]

OK. I see what you want. So I don't have to recreate
If desired, send your file to my address below. I will only look if:
1. You send a copy of this message on an inserted sheet
2. You give me the newsgroup and the subject line
3. You send a clear explanation of what you want
4. You send before/after examples and expected results.

 

[stacia]

file sent
--
Stacia

OK. I see what you want. So I don't have to recreate
If desired, send your file to my address below. I will only look if:
1. You send a copy of this message on an inserted sheet
2. You give me the newsgroup and the subject line
3. You send a clear explanation of what you want
4. You send before/after examples and expected results.

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)


.

 

[stacia]

Fantastic Don, don't know what I would have done without you. Thank you,
Thank you, Thank you.

 

[Don Guillett]

Sub FindTotalSAS()
Call ClearHeadersSAS
Dim lr As Long
Dim c As Range
Dim firstaddress
With Worksheets(1)
lr = .Cells(Rows.Count, 1).End(xlUp).Row
With Range("a1:a" & lr)
Set c = .Find("Total", LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not c Is Nothing Then
firstaddress = c.Address

Do
If Left(c.End(xlDown), 5) = "Grand" Then Exit Sub
Range("a5:g7").Copy Cells(c.Row + 1, 1)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
End With
End With
End Sub