Copy rows with values above x from multiple sheets & copy sheet name to column A

Hi,
I am trying to merge multiple worksheets into one master sheet, there are about 35 sheets in the workbook but I do not want to include Ammendments or Common Process Risks.

I need to search through the worksheets from row 11 down for values greater than 120 in column L and the copy the entire row to the new "Master" sheet with the worksheet name in column A for each sheet.

Hope that makes sense, I have included a sample of the worksheet to help..

forum.ozgrid.com/index.php?attachment/53706/

Thanks in advance

Paul

Re: Copy rows with values above x from multiple sheets & copy sheet name to column A

Quote from Brian Walters;664786

Try this code:

Code

Public Sub MergeData()
Dim ws As Worksheet, i As Long


  For Each ws In Worksheets
    If Not (ws.Name = "Amendments" Or ws.Name = "Common Process Risks" Or ws.Name = "Master") Then
      ws.Select
      For i = 11 To Selection.SpecialCells(xlCellTypeLastCell).Row
        If Range("L" & i).Value > 120 Then
          Range(Range("A" & i), Cells(i, Selection.SpecialCells(xlCellTypeLastCell).Column)).Copy
          Sheets("Master").Select
            Range("B" & Selection.SpecialCells(xlCellTypeLastCell).Row + 1).PasteSpecial xlPasteValues
            Calculate
            Range("A" & Selection.SpecialCells(xlCellTypeLastCell).Row).Value = ws.Name
          ws.Select
        End If
      Next i
    End If
  Next ws
Sheets("Master").Select


End Sub

Display More

I'll try this at work tomorrow as my laptop doesn't have Excel on it..

Cheers

Paul

Re: Copy rows with values above x from multiple sheets & copy sheet name to column A

Works a treat, I got lots of blank rows at the top but have deleted them by modifying the code slightly to clear the sheet first merge data & then delete the blank rows..

Public Sub MergeData()
Dim ws As Worksheet, i As Long

Sheets("Master").Select


Rows("2:3500").Select
Selection.Delete Shift:=xlUp

For Each ws In Worksheets
If Not (ws.Name = "Amendments" Or ws.Name = "Common Process Risks" Or ws.Name = "Master") Then
ws.Select
For i = 11 To Selection.SpecialCells(xlCellTypeLastCell).Row
If Range("L" & i).Value > 120 Then
Range(Range("A" & i), Cells(i, Selection.SpecialCells(xlCellTypeLastCell).Column)).Copy
Sheets("Master").Select
Range("B" & Selection.SpecialCells(xlCellTypeLastCell).Row + 1).PasteSpecial xlPasteValues
Calculate
Range("A" & Selection.SpecialCells(xlCellTypeLastCell).Row).Value = ws.Name
ws.Select
End If
Next i
End If
Next ws
Sheets("Master").Select

Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub

Thanks again

Paul