Rem,
Try the sub below. The assumptions a all your data sheets have the same layout, with headers in
row 1 and data starting in row 2, and the key value is always in the same column on each sheet.
HTH,
Bernie
MS Excel MVP
Sub ExtractDataFromMultipleSheets()
Dim myCell As Range
Dim mySht1 As Worksheet
Dim mySht2 As Worksheet
Dim myKey As Variant
Dim myKeyCell As Range
Dim myArea As Range
Dim myCol As Integer
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Extract").Delete
Application.DisplayAlerts = True
Set mySht1 = Worksheets.Add(Befo=Sheets(1))
mySht1.Name = "Extract"
Set myKeyCell = Application.InputBox( _
"Select a cell with the extract value", , , , , , , 8)
myKey = myKeyCell.Text
myCol = myKeyCell.Column
For Each mySht2 In ActiveWorkbook.Worksheets
If mySht2.Name < mySht1.Name Then
mySht2.Activate
Set myArea = mySht2.Cells(1, myCol).CurrentRegion
With myArea
.AutoFilter Field:=myCol - myArea.Column + 1, Criteria1:=myKey
.Offset(1, 0).Resize(myArea.Rows.Count - 1, .Columns.Count). _
SpecialCells(xlCellTypeVisible).Copy _
mySht1.Range("B65536").End(xlUp)(2)
mySht1.Range(mySht1.Range("A65536").End(xlUp)(2), _
mySht1.Range("B65536").End(xlUp)(1, 0)).Value = mySht2.Name
.AutoFilter
End With
End If
Next mySht2
mySht1.Columns.AutoFit
End Sub
"rem" wrote in message
...
I need to select certain lines from multiple worksheets (based on a field
value) and create a new worksheet containing all the lines. Any help would be
appreciated.
|