combining code and assigning it to different sheets

[apor]

This is my set of subs that i am currently using:

Sub copy3171()
Set range_to_filter = Range("Table4")
range_to_filter.AutoFilter 1, "*3171"
range_to_filter.Copy Sheet2.Cells(1)
range_to_filter.AutoFilter
End Sub

Sub left()
Dim Formul As String
Formul = "=left(RC[-1], 27)"
Range("B1:B" & Cells(Rows.Count, 1).End(xlUp).Row) = [Formul]
End Sub

Sub right()
Dim Formul As String
Formul = "=right(RC[-1], 20)"
Range("C1:C" & Cells(Rows.Count, 1).End(xlUp).Row) = [Formul]
End Sub
Sub removeduplicates()
ActiveSheet.Range("A:BI").removeduplicates Columns:=3, Header:=xlNo
End Sub
Sub duplicates1()
Dim lr As Long, lr2 As Long, i As Long, w As Long
lr = Worksheets("Sheet2").Cells(Rows.Count, "C").End(xlUp).Row
lr2 = Worksheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
For i = 1 To lr
w = Application.WorksheetFunction.Match(Worksheets("Sheet2").Cells(i, "C"), Worksheets("Sheet1").Range("B1:B" & lr2), 0)
' no error checking
Worksheets("Sheet1").Cells(i, "F") = Worksheets("Sheet1").Cells(w, "B")
Worksheets("Sheet1").Cells(i, "G") = Worksheets("Sheet1").Cells(w, "C")
Next i
End Sub

At the moment, i am applying each sub individually and switching between sheets as i do so.

i need sub copy3171 to run first, the result automatically copies to sheet 2.
Problem: i then need to switch to sheet 2 using my mouse to let sub left, right and remove duplicates run.
then, when i let sub duplicates run, the result appears in sheet 1.
Problem: i want this entire set of subs to run in order all while i stay in sheet 1 and watch the final result pop up.

how would i go about doing this????

 

[johnnyL]

How about:

Sub copy3171()
'
    Dim lr As Long, lr2 As Long, i As Long, w As Long
    Dim Formul As String
'
    Set range_to_filter = Range("Table4")
'
    range_to_filter.AutoFilter 1, "*3171"
    range_to_filter.Copy Sheet2.Cells(1)
    range_to_filter.AutoFilter
'
    lr2 = Worksheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
'
'   left
    With Sheet2
        Formul = "=left(RC[-1], 27)"
        .Range("B1:B" & .Cells(.Rows.Count, 1).End(xlUp).Row) = [Formul]
'
'   right
        Formul = "=right(RC[-1], 20)"
        .Range("C1:C" & .Cells(.Rows.Count, 1).End(xlUp).Row) = [Formul]
'
'   removeduplicates
        .Range("A:BI").removeduplicates Columns:=3, Header:=xlNo
'
'   duplicates1
        lr = .Cells(.Rows.Count, "C").End(xlUp).Row
'
        For i = 1 To lr
            w = Application.WorksheetFunction.Match(Worksheets("Sheet2").Cells(i, "C"), Worksheets("Sheet1").Range("B1:B" & lr2), 0)
'
'           no error checking
            Worksheets("Sheet1").Cells(i, "F") = Worksheets("Sheet1").Cells(w, "B")
            Worksheets("Sheet1").Cells(i, "G") = Worksheets("Sheet1").Cells(w, "C")
        Next i
    End With
End Sub

 

[apor]

How about:

Sub copy3171()
'
    Dim lr As Long, lr2 As Long, i As Long, w As Long
    Dim Formul As String
'
    Set range_to_filter = Range("Table4")
'
    range_to_filter.AutoFilter 1, "*3171"
    range_to_filter.Copy Sheet2.Cells(1)
    range_to_filter.AutoFilter
'
    lr2 = Worksheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
'
'   left
    With Sheet2
        Formul = "=left(RC[-1], 27)"
        .Range("B1:B" & .Cells(.Rows.Count, 1).End(xlUp).Row) = [Formul]
'
'   right
        Formul = "=right(RC[-1], 20)"
        .Range("C1:C" & .Cells(.Rows.Count, 1).End(xlUp).Row) = [Formul]
'
'   removeduplicates
        .Range("A:BI").removeduplicates Columns:=3, Header:=xlNo
'
'   duplicates1
        lr = .Cells(.Rows.Count, "C").End(xlUp).Row
'
        For i = 1 To lr
            w = Application.WorksheetFunction.Match(Worksheets("Sheet2").Cells(i, "C"), Worksheets("Sheet1").Range("B1:B" & lr2), 0)
'
'           no error checking
            Worksheets("Sheet1").Cells(i, "F") = Worksheets("Sheet1").Cells(w, "B")
            Worksheets("Sheet1").Cells(i, "G") = Worksheets("Sheet1").Cells(w, "C")
        Next i
    End With
End Sub

thank you it worked perfectly