Combining Selected Worksheets into One

[Vlr516]

I am spending way too much time combining worksheets onto a summary sheet. Is there vba code that could do this for me? I must combine worksheets together that have "REQ" somewhere in the tab name within the active workbook which could be one tab or several. My only worry here is the author of the workbook could have changed the name of the tab.

The other way I could do it is have a list of sheets in the workbook, and I select the tabs would like to combine.

I am not sure of which option to choose or how to start the code for this one. Any suggestions?

 

[Vlr516]

add a "+1" after .Row

>>.End(xlUp).Row + 1

Now with the + 1 it is skipping every other line. Maybe I missed putting a +1 somewhere?

Here is my current code:

Sub Test()
Dim wbPPM As Workbook
Dim shtTest As Worksheet, sht As Worksheet
Dim i As Long, FinalRow As Long, dRow As Long, dCol As Long, sRow As Long

'stops screen flicker
With Application
    .ScreenUpdating = False
End With

'assigns variable names to the open workbook
Set wbPPM = ThisWorkbook
Set shtTest = wbPPM.Worksheets("Summary")
    dRow = 6
    dCol = 1

'evaluates sheet names for "Req" at beginning of title
For Each sht In wbPPM.Worksheets
    If (Left(sht.Name, 3)) = "Req" Then
    'assigning range of source data
    sRow = 6
    FinalRow = sht.Cells(Rows.Count, 3).End(xlUp).Row + 1
        
        'assigning range of destination data
        For sRow = 6 To FinalRow
        
            'eliminating blank rows, concatenate ReqNo & ReqName and insert Desc
            If sht.Cells(sRow, 3) <> "" Then
                With shtTest
                    shtTest.Cells(dRow, dCol).Value = sht.Cells(sRow, 1).Value & "--" & sht.Cells(sRow, 3).Value
                    shtTest.Cells(dRow, 8).Value = sht.Cells(sRow, 4).Value
                End With
                
                'move down one row on source sheet and destination sheet until final row
                sRow = sRow + 1
            Else: sRow = sRow + 1: GoTo sRow
            End If
        dRow = dRow + 1
sRow:         Next sRow
        Else: GoTo Nexti
        End If
        
'move to next sheet
Nexti:  Next sht
End Sub