Search Word "End" and copy above row to new tab by VB

[PPOOQQ]

BATCH	IntDate	AccountNum	LineDescription	Product Type	DebitAmt	CreditAmt		FacilityID
IPF-2607	26/07/2014	-11002	Clem20140726	Fee1	0	44.88		75
IPF-2607	26/07/2014	-11002	Clem20140726	Fee1	0	88.66		75
IPF-2607	26/07/2014	-11036	Clem20140726	Fee1	44.88	0		75
IPF-2607	26/07/2014	-11036	Clem20140726	Fee1	88.66	0		75
IPF-2607	26/07/2014	END	Clem20140726	0	0	0		EN
IPF-2607	26/07/2014		Clem20140726	0	0	0
can anyone help me?		I want to copy all rows to new tab above the row which has "END"

<tbody>
</tbody><colgroup><col><col><col><col><col><col><col><col><col></colgroup>

 

[hiker95]

Private Message from PPOOQQ:

thanks so much! it works ! now I need to look at how to apply this to my other 18 tabs !

it is hard than I think. maybe I should not learn VB
thanks again!

Please list the names of all the tabs (where the macro will run against), within quote marks for each tab name, like the following:

"Video fee-posting"
"revenue-posting"

 

[hiker95]

Another Private Message from PPOOQQ:

thanks a lot I copy everything to model . It works perfectly

thanks sooooooo much

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.

 

[hiker95]

PPOOQQ,

If you had supplied me with the list of worksheets, per my reply #11, I could have added the information into the following ws array.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Sub CopyAboveEND_V4()
' hiker95, 07/29/2014, ME794581
Dim ws As Variant, wd As Worksheet
Dim i As Long, nr As Long, r As Long, lr As Long, fr As Long
Application.ScreenUpdating = False

ws = Array("Video fee-posting", "revenue-posting")

Set wd = Sheets("Data")
wd.Columns("A:I").ClearContents
For i = LBound(ws) To UBound(ws)
  With Sheets(ws(i))
    If .FilterMode = True Then
      .ShowAllData
    End If
    lr = .Cells(Rows.Count, 1).End(xlUp).Row
    For r = 2 To lr Step 1
      If .Cells(r, 3).Value = "END" Then
        fr = r
        Exit For
      End If
    Next r
    nr = wd.Cells(wd.Rows.Count, "A").End(xlUp).Row + 1
    .Range("A2:I" & fr - 1).Copy
    wd.Range("A" & nr).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
  End With
Next i
With wd
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  .Range("B2:B" & lr).NumberFormat = "m/d/yyyy"
  .Range("F2:G" & lr).NumberFormat = "_-* #,##0.00_-;-* #,##0.00_-;_-* ""-""??_-;_-@_-"
  .Columns("A:I").AutoFit
  .Range("A1").Select
  .Activate
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the CopyAboveEND_V4 macro.