Hi Jules

I have made a new approach to your problem :-)

The macro creates a new workbook, where the the desired result is copied to.

I have estimated the range to copy, change the CopyRange if it doesn't suit
your needs.

Sub RemoveLines_WithFilter()
Dim ws As Variant
Dim LastRow As Double
Dim FirstRow As Double
Dim r As Variant
Dim CostCenter
Dim TargetColumn As String
Dim NewWb As Workbook
Dim OldWb As Workbook
Dim NewWs As Worksheet
Dim CopyRange As String

Application.ScreenUpdating = False
Set OldWb = ThisWorkbook
Set NewWb = Workbooks.Add

CopyRange = "A1:P1386" ' Change to suit the _
range containing data
TargetColumn = "G"
FirstRow = 6
LastRow = 1367
OldWb.Activate

For Each ws In OldWb.Worksheets
Set NewWs = NewWb.Sheets.Add
Debug.Print ws.Name
NewWs.Name = ws.Name
Next

For Each ws In OldWb.Worksheets
CostCenter = ws.Name
ws.Select
Range(Cells(FirstRow, TargetColumn), _
Cells(LastRow, TargetColumn)).Select
Selection.AutoFilter Field:=1, Criteria1:=CostCenter
Range("A1:M45").Copy NewWb.Sheets(CostCenter).Range("A1")
Selection.AutoFilter
Next

Application.ScreenUpdating = True
End Sub

Best regards,
Per

"Jules" skrev i meddelelsen
...
Hi Per,

I've tried to run this different ways...The workbook has apporx 84 sheets,
all the same...I need to break out each sheet according to the tab
name...as
you know.

When I run this (I've tried selecting all sheets and running it as well as
just one sheet), I get the hour glass for about twenty minutes than I end
task and only one sheet has been changed (correctly), the others are not
touched...it doesn't matter how long it runs, you have to end task to get
out...

Just thought I'd update you on this...

Sign me....

Still looking for a fix.

kind regards Per.
--
Jules


"Per Jessen" wrote:

Hi Jules

Does the macro comes up with an error or what is the problem at the end
if
line?

This macro will look at rows 6-1367 and delete rows where the CostCenter
in
column G is not equal to the cost center on the tab.

Sub RemoveLines()
Dim sh As Variant
Dim LastRow As Double
Dim FirstRow As Double
Dim r As Variant
Dim TargetColumn As String

TargetColumn = "G"
FirstRow = 6
LastRow = 1367

For Each sh In ThisWorkbook.Sheets
CostCenter = sh.Name
With sh
For r = LastRow To FirstRow Step -1
If .Cells(r, TargetColumn).Value < CostCenter Then
.Rows(r).Delete
End If
Next
End With
Next
End Sub

Regards,
Per

"Jules" skrev i meddelelsen
...
Thanks Per....the macro is having trouble at the End if line...also, I
need
to keep the last few lines in tact on each sheet (rows a1368 - 1386)
Also,
the row is A6 and the data in the sheet referencing the cost center is
in
column G. I don't know if this helps...

Would it be easier to start with the one template and bust out the
sheets
by
cost center with a different macro? Right now I've used ASAP utilitly
to
break out the sheets by cost center...but if you know a better way...?

Thanks so much for all your help.,
--
Jules


"Per Jessen" wrote:

On 22 Apr., 02:31, Jules wrote:
Hi, I have a workbook containing approx 80 worksheets, all are
exactly
a
like. All the sheets names are seven digits (cost centers), these
numbers
can be found in the sheet.

I need to delete all the lines not associated with the tab name
(which
I
have referenced in C3). There are many subtotals in the worksheets;
these
consist of staff positions within the cost center.

So, in essence, I have all the cost centers on each tab, but only
need
the
info for the cost center referenced by the tab.

Is this possible? Can anyone please help me? I'm an intermediate
user
but
I follow directions fairly well.

Sign me

Despreate in B'more
--
Jules

Hi

Try this on a copy of your workbook. Change TargetColumn and FirstRow
to suit.

Sub RemoveLines()
Dim sh As Variant
Dim LastRow As Double
Dim FirstRow As Double
Dim r As Variant
Dim TargetColumn As String

TargetColumn = "A"
FirstRow = 5

For Each sh In ThisWorkbook.Sheets
CostCenter = sh.Name
With sh
LastRow = .Range("A65536").End(xlUp).Row
For r = LastRow To FirstRow Step -1
If .Cells(r, TargetColumn).Value < CostCenter Then
.Rows(r).Delete
End If
Next
End With
Next
End Sub

Best regards,
Per