applying the code on each sheet except few - excel

Question

I have below code which is working fine with one sheet data i.e on sheet 2, now i wanted to run same code on other worksheet too i.e sheet 4, sheet 5, sheet 6 and sheet 7 to cut the data from these sheet and paste it in sheet 3 as per below codes.
the below code will work as below
I have master Data in Sheet 2 (Column B) and search criteria in Sheet 1 (Column A), i want VBA to find all the data from Sheet 1 (Column A) in Sheet 2 (Column B) if found cut the entire row and past it into Sheet 3 next available row.
i wanted to run same code on other worksheet too i.e sheet 4, sheet 5, sheet 6 and sheet 7 to cut the data from these sheet and paste it in sheet 3 as per below codes.
Option Explicit
Sub remDup()
' Constants
Const sName As String = "Sheet1"
Const sFirst As String = "A1"
Const lName As String = "Sheet2"
Const lFirst As String = "B1"
Const dName As String = "Sheet3"
Const dFirst As String = "A1"
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Source
Dim sws As Worksheet: Set sws = wb.Worksheets(lName)
Dim srg As Range: Set srg = refColumn(sws.Range(lFirst))
If srg Is Nothing Then Exit Sub
Dim sData As Variant: sData = getColumn(srg)
' Lookup
Dim lws As Worksheet: Set lws = wb.Worksheets(sName)
Dim lrg As Range: Set lrg = refColumn(lws.Range(sFirst))
If lrg Is Nothing Then Exit Sub
Dim lData As Variant: lData = getColumn(lrg)
' Match
Dim trg As Range
Dim i As Long
For i = 1 To UBound(sData)
If foundMatchInVector(sData(i, 1), lData) Then
Set trg = getCombinedRange(trg, srg.Cells(i))
End If
Next i
' Destination
If Not trg Is Nothing Then
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
' This is a kind of a ridiculous use of "refColumn".
Dim drg As Range: Set drg = refColumn(dws.Range(dFirst))
If drg Is Nothing Then
Set drg = dws.Range(dFirst).EntireRow
Else
Set drg = drg.Cells(drg.Cells.Count).Offset(1).EntireRow
End If
trg.EntireRow.Copy drg
trg.EntireRow.Delete
End If
End Sub
' Assumptions: 'FirstCellRange' is a one-cell range e.g. 'Range("A1")'.
' Returns: Either the range from 'FirstCellRange' to the bottom-most
' non-empty cell in the column, or 'Nothing' if all cells
' below 'FirstCellRange' (incl.) are empty.
Function refColumn( _
ByVal FirstCellRange As Range) _
As Range
With FirstCellRange
Dim cel As Range
Set cel = .Resize(.Worksheet.Rows.Count - .Row + 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If Not cel Is Nothing Then
Set refColumn = .Resize(cel.Row - .Row + 1)
End If
End With
End Function
' Assumptions: 'rg' is a one-column range e.g. 'Range("A1")', 'Range("A1:A2")'.
' Returns: A 2D one-based one-column array.
Function getColumn( _
rg As Range) _
As Variant
If rg.Rows.Count > 1 Then
getColumn = rg.Value
Else
Dim OneElement As Variant: ReDim OneElement(1 To 1, 1 To 1)
OneElement(1, 1) = rg.Value
getColumn = OneElement
End If
End Function
' Assumptions: 'MatchValue' is a simple data type (not an object or an array).
' 'Vector' is a structure that 'Application.Match' can handle,
' e.g. a 1D array, a one-column or one-row range or 2D array.
' Returns: 'True' or 'False' (boolean).
' Remarks: Error values and blanks are ignored ('False').
Function foundMatchInVector( _
ByVal MatchValue As Variant, _
ByVal Vector As Variant) _
As Boolean
If Not IsError(MatchValue) Then
If Len(MatchValue) > 0 Then
foundMatchInVector _
= IsNumeric(Application.Match(MatchValue, Vector, 0))
End If
End If
End Function
' Assumptions: 'AddRange' is not 'Nothing' and it is in the same worksheet
' as 'BuiltRange'.
' Returns: A range (object).
Function getCombinedRange( _
ByVal BuiltRange As Range, _
ByVal AddRange As Range)
If BuiltRange Is Nothing Then
Set getCombinedRange = AddRange
Else
Set getCombinedRange = Union(BuiltRange, AddRange)
End If
End Function

Answer 1

Change the constant to a variable and put the main part of your code in a loop. For example (untested)
Option Explicit
Sub remDup()
' Constants
Const sName As String = "Sheet1"
Const sFirst As String = "A1"
'Const lName As String = "Sheet2"
Const lFirst As String = "B1"
Const dName As String = "Sheet3"
Const dFirst As String = "A1"
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Lookup
Dim lws As Worksheet: Set lws = wb.Worksheets(sName)
Dim lrg As Range: Set lrg = refColumn(lws.Range(sFirst))
If lrg Is Nothing Then Exit Sub
Dim lData As Variant: lData = getColumn(lrg)
' Match
Dim trg As Range
Dim i As Long
' Destination
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
Dim drg As Range: Set drg = refColumn(dws.Range(dFirst))
' Source
Dim sws As Worksheet
Dim srg As Range:
Dim sData As Variant
Dim lname As Variant
For Each lname In Array("Sheet2", "Sheet4", "Sheet5", "Sheet6", "Sheet7")
' Source
Set sws = wb.Worksheets(lname)
Set srg = refColumn(sws.Range(lFirst))
If Not srg Is Nothing Then
sData = getColumn(srg)
' Match
For i = 1 To UBound(sData)
If foundMatchInVector(sData(i, 1), lData) Then
Set trg = getCombinedRange(trg, srg.Cells(i))
End If
Next i
' Destination
If Not trg Is Nothing Then
trg.EntireRow.Copy drg
trg.EntireRow.Delete
Set drg = drg.Offset(1)
End If
End If
Next
End Sub