Copy and Paste 3 sheets to 1

Take a look to this.

http://excel.tips.net/T003005_Conden..._Into_One.html

Not the fastest way or best way but ...since you don't want to transfer blank lines....
also note that it will add some text at end of text for each sheet this is to know when to step out of it.

Sub test()
'this is under the assumption you have 4 sheets in 1 workbook ,  having the date you want to merge on the 4th sheet
'remember to adjust the namines of the sheets where indicated with ////change////
For S = 1 To 3
Dim sheetnaming As String
If S = 1 Then
sheetnaming = "your first name" '////change////
Sheets(sheetnaming).Cells(65000, 1).End(xlUp).Offset(1, 0).Value = "Last Line"
ElseIf S = 2 Then
sheetnaming = "your second name" '////change////
Sheets(sheetnaming).Cells(65000, 1).End(xlUp).Offset(1, 0).Value = "Last Line"
ElseIf S = 3 Then
sheetnaming = "your third name" '////change////
Sheets(sheetnaming).Cells(65000, 1).End(xlUp).Offset(1, 0).Value = "Last Line"
End If

For i = 1 To 65000
Dim transfer As String
transfer = Sheets(sheetnaming).Range("A" & i).Value

'////change the 3in1 in blow lines////
If transfer = "Last Line" Then
Sheets("3in1").Cells(65000, 1).End(xlUp).Offset(1, 0).Value = "--------------------------------------------------------------------------"
GoTo endofsheetdata:
Else
    If transfer = "" Then
    Else
    Sheets("3in1").Cells(65000, 1).End(xlUp).Offset(1, 0).Value = transfer
    End If
End If
Next i

endofsheetdata:
Next S
End Sub

Well the fact you mention its filterd i assume you have not only data in column A but also in plenty of other columns
The code provided only takes from column A see =>

transfer = Sheets(sheetnaming).Range("A" & i).Value

So then you better go with the tool provided above and dont worry about blank rows being transferd also.

OK, try the following code (in a standard module). It will take all the cells on sheets PR and SC and copy them to sheet Final.

It starts on Row 1 but you can adjust that if necessary.

Option Explicit

Sub Collate_Sheets_TMS3()
Dim lLR As Long         ' Last row on Input Sheet(s)
Dim lLC As Long         ' Last column on Input Sheet(s)
Dim lNR As Long         ' Next row on Output Sheet
Dim wShts               ' Array of sheet names
Dim wSht As Worksheet   ' sheet variable for loop
Dim bFirstTime As Boolean

Set wShts = Sheets(Array("PR", "SC"))
bFirstTime = True

Application.ScreenUpdating = False
With Sheets("Final")
    .Cells.Clear
End With
For Each wSht In wShts
    With wSht
        lLR = .Cells.SpecialCells(xlCellTypeLastCell).Row
        lLC = .Cells.SpecialCells(xlCellTypeLastCell).Column
        With Sheets("Final")
            If bFirstTime Then
                bFirstTime = False
                lNR = 1
            Else
                lNR = .Cells.SpecialCells(xlCellTypeLastCell).Row + 1
            End If
        End With
        On Error Resume Next
        With .Range(.Cells(1, 1), .Cells(lLR, lLC))
                    .Copy _
                Sheets("Final").Range("A" & lNR)
        End With
        On Error GoTo 0
    End With
Next 'wSht
Application.ScreenUpdating = True
End Sub

Regards, TMS

Maybe see this post:

Error in VBA

Option Explicit

Sub Collate_Sheets_TMS2()
Dim lLR As Long         ' Last row on Input Sheet(s)
Dim lLC As Long         ' Last column on Input Sheet(s)
Dim lNR As Long         ' Next row on Output Sheet
Dim wShts               ' Array of sheet names
Dim wSht As Worksheet   ' sheet variable for loop

Set wShts = Sheets(Array("Plan&Status", "Delivered_Projects"))

Application.ScreenUpdating = False
With Sheets("Consolidated")
    .Cells.Clear
End With
For Each wSht In wShts
    With wSht
        lLR = .Range("A" & .Rows.Count).End(xlUp).Row
        lLC = .Cells(1, .Columns.Count).End(xlToLeft).Column
        With Sheets("Consolidated")
            lNR = .Range("A" & .Rows.Count).End(xlUp).Row + 1
        End With
        .Range(.Cells(1, 1), .Cells(lLR, lLC)).Copy _
            Sheets("Consolidated").Range("A" & lNR)
    End With
Next 'wSht
Application.ScreenUpdating = True
End Sub

Regards, TMS