使用相同的代码循环遍历多个范围

我是VBA的新手，我想寻求帮助。 我想清除代码，因为我在多个范围内使用相同的循环代码。

我有表格，我喜欢10个表格（位于2列x 5以下）。每个表最多可包含5行，并具有4列（5x4）。

我想通过vba从新表中的表中导入输入。 因此，我为某些范围创建了一个循环。范围是（第54：58、65：69、76：80、87：91、98：102行），第（3-6）列和（9-12） 我不想导入空白字段，因此存在一个条件。

有没有一种方法可以简化代码，而不必循环每个范围？像“循环这些范围”之类的东西，只在那里有一次代码？

Dim wb As Workbook
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim p As Long, i As Long
Dim lastrowPest As Long, lastrowField As Long

Set wb = ActiveWorkbook
Set wsSource = wb.Sheets("Field entry - plan")
Set wsTarget = wb.Sheets("List3")


lastrowField = wsSource.Cells(Rows.Count, 20).End(xlUp).row

For p = 54 To 58

    For i = 3 To lastrowField

        If wsSource.Cells(p, 4) <> "" Then

        lastrowPest = wsTarget.Cells(Rows.Count, 24).End(xlUp).Offset(1, 0).row

        wsSource.Range(wsSource.Cells(i, 20), wsSource.Cells(i, 20)).copy
        wsTarget.Range(wsTarget.Cells(lastrowPest, 24), wsTarget.Cells(lastrowPest, 24)).PasteSpecial Paste:=xlPasteValues

        wsSource.Range(wsSource.Cells(i, 34), wsSource.Cells(i, 34)).copy
        wsTarget.Range(wsTarget.Cells(lastrowPest, 30), wsTarget.Cells(lastrowPest, 30)).PasteSpecial Paste:=xlPasteValues

        wsSource.Range(wsSource.Cells(p, 3), wsSource.Cells(p, 6)).copy
        wsTarget.Range(wsTarget.Cells(lastrowPest, 26), wsTarget.Cells(lastrowPest, 28)).PasteSpecial Paste:=xlPasteValues

        End If

        If wsSource.Cells(p, 10) <> "" Then

        lastrowPest = wsTarget.Cells(Rows.Count, 24).End(xlUp).Offset(1, 0).row

        wsSource.Range(wsSource.Cells(i, 20), wsSource.Cells(i, 20)).copy
        wsTarget.Range(wsTarget.Cells(lastrowPest, 24), wsTarget.Cells(lastrowPest, 24)).PasteSpecial Paste:=xlPasteValues

        wsSource.Range(wsSource.Cells(i, 34), wsSource.Cells(i, 34)).copy
        wsTarget.Range(wsTarget.Cells(lastrowPest, 30), wsTarget.Cells(lastrowPest, 30)).PasteSpecial Paste:=xlPasteValues

        wsSource.Range(wsSource.Cells(p, 9), wsSource.Cells(p, 12)).copy
        wsTarget.Range(wsTarget.Cells(lastrowPest, 26), wsTarget.Cells(lastrowPest, 28)).PasteSpecial Paste:=xlPasteValues

        End If
    Next i

Next p


For p = 65 To 69

    For i = 3 To lastrowField

        If wsSource.Cells(p, 4) <> "" Then

        lastrowPest = wsTarget.Cells(Rows.Count, 24).End(xlUp).Offset(1, 0).row

        wsSource.Range(wsSource.Cells(i, 20), wsSource.Cells(i, 20)).copy
        wsTarget.Range(wsTarget.Cells(lastrowPest, 24), wsTarget.Cells(lastrowPest, 24)).PasteSpecial Paste:=xlPasteValues

        wsSource.Range(wsSource.Cells(i, 34), wsSource.Cells(i, 34)).copy
        wsTarget.Range(wsTarget.Cells(lastrowPest, 30), wsTarget.Cells(lastrowPest, 30)).PasteSpecial Paste:=xlPasteValues

        wsSource.Range(wsSource.Cells(p, 3), wsSource.Cells(p, 6)).copy
        wsTarget.Range(wsTarget.Cells(lastrowPest, 26), wsTarget.Cells(lastrowPest, 28)).PasteSpecial Paste:=xlPasteValues

        End If

        If wsSource.Cells(p, 10) <> "" Then

        lastrowPest = wsTarget.Cells(Rows.Count, 24).End(xlUp).Offset(1, 0).row

        wsSource.Range(wsSource.Cells(i, 20), wsSource.Cells(i, 20)).copy
        wsTarget.Range(wsTarget.Cells(lastrowPest, 24), wsTarget.Cells(lastrowPest, 24)).PasteSpecial Paste:=xlPasteValues

        wsSource.Range(wsSource.Cells(i, 34), wsSource.Cells(i, 34)).copy
        wsTarget.Range(wsTarget.Cells(lastrowPest, 30), wsTarget.Cells(lastrowPest, 30)).PasteSpecial Paste:=xlPasteValues

        wsSource.Range(wsSource.Cells(p, 9), wsSource.Cells(p, 12)).copy
        wsTarget.Range(wsTarget.Cells(lastrowPest, 26), wsTarget.Cells(lastrowPest, 28)).PasteSpecial Paste:=xlPasteValues

        End If
    Next i

Next p