Monster Delete/Copy over 150 worksheets

[spcalan]

Ok, here goes nothing...

I have 150 worksheets ( that are downloads from website - think data/from web ) - so 150 webpage extractions.

Each worksheet is roughly 600 lines.

I only need the rows that start with ($).

I am thinking I should just extract those rows ( rather than delete the non($) rows ).

Any suggestions on how to do this?

 

[bryonwoods30]

are the files all random names?

 

[spcalan]

are the files all random names?

Nope, they are from a list in another worksheet.

So I have a worksheet with 150+ names - and each 150 worksheets are named exactly.

 

[bryonwoods30]

ok what you will need to do the following
create 2 modules/macros

so first one push alt f11 and put in the following macro, it will open the file open window, just select all your excel files and hit ok. this will pull all of the sheets into one huge workbook.
_____________________________________________
Sub CombineWorkbooks()
Dim FilesToOpen
Dim x As Integer

On Error GoTo ErrHandler
Application.ScreenUpdating = False

FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Microsoft Excel Files (*.xls), *.xls", _
MultiSelect:=True, Title:="Files to Merge")

If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If

x = 1
While x <= UBound(FilesToOpen)
Workbooks.Open FileName:=FilesToOpen(x)
Sheets().Move After:=ThisWorkbook.Sheets _
(ThisWorkbook.Sheets.Count)
x = x + 1
Wend

ExitHandler:
Application.ScreenUpdating = True
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub

__________________________________________

next go alt f11 again and do this macro, it will create a sheet called "master" sheet that will append all the data from all your other sheets

_________________________________________________

Sub CopyFromWorksheets()
Dim wrk As Workbook 'Workbook object - Always good to work with object variables
Dim sht As Worksheet 'Object for handling worksheets in loop
Dim trg As Worksheet 'Master Worksheet
Dim rng As Range 'Range object
Dim colCount As Integer 'Column count in tables in the worksheets

Set wrk = ActiveWorkbook 'Working in active workbook

For Each sht In wrk.Worksheets
If sht.Name = "Master" Then
MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _
"Please remove or rename this worksheet since 'Master' would be" & _
"the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error"
Exit Sub
End If
Next sht

'We don't want screen updating
Application.ScreenUpdating = False

'Add new worksheet as the last worksheet
Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
'Rename the new worksheet
trg.Name = "Master"
'Get column headers from the first worksheet
'Column count first
Set sht = wrk.Worksheets(1)
colCount = sht.Cells(1, 255).End(xlToLeft).Column
'Now retrieve headers, no copy&paste needed
With trg.Cells(1, 1).Resize(1, colCount)
.Value = sht.Cells(1, 1).Resize(1, colCount).Value
'Set font as bold
.Font.Bold = True
End With

'We can start loop
For Each sht In wrk.Worksheets
'If worksheet in loop is the last one, stop execution (it is Master worksheet)
If sht.Index = wrk.Worksheets.Count Then
Exit For
End If
'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
'Put data into the Master worksheet
trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
Next sht
'Fit the columns in Master worksheet
trg.Columns.AutoFit

'Screen updating should be activated
Application.ScreenUpdating = True
End Sub

_________________________________________

go to the master sheet and filter on your $ sign

 

[spcalan]

Thanks for the response..

Let me start over - I have 1 workbook, with 150+ worksheets in it.

Each worksheet's name is listed in a "City List' worksheet.


I need to only keep the rows in each worksheet that start with ($).

 

[bryonwoods30]

in that case just use my second macro in the workbook with the 150 sheets, it will combine then all together into one sheet, then just filter by the column that has the $ in it you want to keep

 

[spcalan]

WOW - Just absolutely perfect and **** fast too.

This is EXACTLY what I needed!!!

 

[MrKowz]

Try:

Public Sub ConsolidateWorkbookSpcalan()
'Variable Declaration: dWS = Destination Worksheet, sLR = Source Worksheet Last Row
'                      dLR = Destination Last Row
Dim ws          As Worksheet, _
    dWS         As Worksheet, _
    sLR         As Long, _
    dLR         As Long, _
    rng         As Range, _
    firstrng    As String
    
Application.ScreenUpdating = False
Sheets.Add Before:=Sheets(1)
ActiveSheet.Name = "Master"
Set dWS = ActiveSheet
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> dWS.Name Then
        sLR = ws.Range("A" & rows.Count).End(xlUp).row
        With ws.Range("A1:A" & LR)
            Set rng = .Find("$", LookIn:=xlValues)
            If Not rng Is Nothing Then
                firstrng = rng.Address
                Do
                    If left$(rng.Value, 1) = "$" Then
                        dLR = dWS.Range("A" & rows.Count).End(xlUp).row + 1
                        rng.EntireRow.Copy Destination:=dWS.Range("A" & LR)
                    End If
                    Set rng = .FindNext(rng)
                Loop While Not rng Is Nothing And rng.Address <> rng1
             End If
        End With
    End If
Next ws
Application.ScreenUpdating = True
End Sub