Sub MoveInProgress()
'Change this to the real name of your 'Master' worksheet
Const cstMasterWorksheetName = "Master"
Dim wksSheet As Worksheet, wksMaster As Worksheet
Dim lngInputRow As Long, lngOutputRow As Long, lngColumnIndex As Long
Dim strColumnA As String
'Get the 'Master' worksheet and find the last row & column
Set wksMaster = Worksheets(cstMasterWorksheetName)
lngOutputRow = wksMaster.UsedRange.Rows.Count
lngColumnIndex = wksMaster.UsedRange.Columns.Count
'Cysle through all the worksheets in the workbook
For Each wksSheet In Worksheets
'reset input row for each sheet
lngInputRow = 0
'Skip the 'Master' sheet
If wksSheet.Name <> cstMasterWorksheetName Then
Do
'Index the row in the input sheet
lngInputRow = lngInputRow + 1
'Grab the value in column A to test
strColumnA = wksSheet.Cells(lngInputRow, 1)
'Test for 'In Progress' and copy row if it exists
If strColumnA = "In Progress" Then
'Move to the new row in the output sheet
lngOutputRow = lngOutputRow + 1
'Cycle through all the columns in this row
For lngColumnIndex = 1 To lngColumnIndex
wksMaster.Cells(lngOutputRow, lngColumnIndex) = wksSheet.Cells(lngInputRow, lngColumnIndex)
Next lngColumnIndex
End If
Loop Until strColumnA = ""
End If
Next wksSheet
End Sub