如果工作表sheet2上的单元格与工作表sheet1上的单元格匹配，则将行从工作表2复制到工作表1并循环到下一行

Question

Everyone I am new to code and VBA Excell. I have a Sub that works, I'm just not sure if it's the right way to do it or if there is a more efficient way as it takes a while to complete when run. I was just wondering if someone can have a look and maybe give me some pointers.

I will put my code below I hope I'm doing this right.

Thanks Carly

Sub DataPopulate()
    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range
    Dim num As Range
    Set wb = ActiveWorkbook
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    Set rng1 = Range("F2")
    Set num = ws1.Range("F2:F4")

'When you click the Click this to populate data MSRP Pricing button you will get the yes no message box.

    If MsgBox("Click yes to continue" & vbCrLf & "Excel may say not responding!!!" _
        & vbCrLf & "It just may take a few moments", vbYesNo + vbQuestion) = vbYes Then
        'If the yes button is pushed in the message box.
        ws1.Activate
        Range("e18") = ("MSRP List")
        'MSRP List text is copied to cell e18.
        Range("h2:h16").Value = Range("g2:g16").Value
        'The product group list is copied from colum g to h.

        ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:= _
            Range("f2:f16"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
            'The numbers in f2~f16 is sorted in assending order along with the product group name.
        End With

        Dim Lastrow As Integer
            Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
            ws1.Activate
            Range("A23:L" & Lastrow).ClearContents ' Select
            'Selection.ClearContents
            'Count from A23 to column L and the last row with data, then select that and delete.
            Range("A22") = ("Group")
            Range("b22") = ("Description")
            Range("c22") = ("Code")
            Range("d22") = ("Barcode")
            Range("e22") = ("List Number")
            'Copy the data list headings

            a = ws2.Cells(Rows.Count, 1).End(xlUp).Row
            'Count rows of CSV data on sheet2 and set veriable for "a" this is the number of times to run the loop below.
            'MsgBox (a) '<testing count number
        For i = 2 To a
        Dim d As Range
            If ws1.Range("f2").Value = ("1") And ws2.Cells(i, 1).Value = ws1.Range("g2") Then
            'Checking if order of product group f2 = 1
            'and if there is a match in sheet2 column A row 1 with G2 in product group list
                    b = ws1.Cells(Rows.Count, 1).End(xlUp).Row
                    ws2.Rows(i).Copy
                    ws1.Cells(b + 1, 1).PasteSpecial Paste:=xlPasteValues
                    'Then copy that row to sheet1 in the next empty row
                End If
                'Loop will do the next rows till "a" times loops are done
            Next

        'This is the same for below until all product groups are done
        For i = 2 To a
            If ws1.Range("f3") = 2 And ws2.Cells(i, 1).Value = ws1.Range("g3") Then
                    b = ws1.Cells(Rows.Count, 1).End(xlUp).Row
                    ws2.Rows(i).Copy
                    ws1.Cells(b + 1, 1).PasteSpecial Paste:=xlPasteValues
                End If
            Next

        For i = 2 To a
            If ws1.Range("f4") = 3 And ws2.Cells(i, 1).Value = ws1.Range("g4") Then
                    b = ws1.Cells(Rows.Count, 1).End(xlUp).Row
                    ws2.Rows(i).Copy
                    ws1.Cells(b + 1, 1).PasteSpecial Paste:=xlPasteValues
                End If
            Next

        Dim rng As Range
        Set rng = Range("F2:f1000")
        'Loop backwards through the rows
        'in the range that you want to evaluate.
        For i = rng.Rows.Count To 1 Step -1

            'If cell i in the range contains an "0", delete the entire row.
            If rng.Cells(i).Value = "0" Then rng.Cells(i).EntireRow.Delete
            'Deleting rows with at 0
        Next

        Application.CutCopyMode = False
        'ThisWorkbook.ws1.calls(1, 22).Select
            ws1.Activate
        Range("A24:E24").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -4.99893185216834E-02
            .PatternTintAndShade = 0
        End With
        Range("A23:E24").Select
        Selection.Copy
        Application.CutCopyMode = False
        Selection.Copy
        Range("A25:E1000").Select
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        Range("A21").Select
        'Adding grey scale to the rows to make is eazier to read.
        'Else


    End If
End Sub

Answer 1

So a basic principal of programming is that your functions/subroutines should only have one job. The first step I would take to improve your code would be breaking your code up into more subroutines using this principal. I won't go too in depth on the advantage of this because there's already loads of resources explaining why to do things this way. This thread has some good explanations, as well as draw backs to breaking your code up too much this way.

What I always do is start with a subroutine called Main() with a job that is simply to call the other functions in the program and pass variables between them as necessary. Make sure all your functions/subroutines have names that describe their purpose and then you will know exactly what your program is doing at each step of the process simply by looking at Main.