请教大神，我的代码如何才能更简洁一些

NAZXL

Sub 原料跟踪()

    On Error Resume Next
    Workbooks.Open Filename:="G:\VB\原材料下单跟踪表.XLSM"
    Application.ScreenUpdating = False
    ThisWorkbook.Activate
    Dim I As Integer, SHT As Worksheet, EROW As Integer, wb1 As Worksheet, x As Range, j As Integer
    I = 9
    Set SHT = ThisWorkbook.Worksheets("原料采购合同（表纱）")
    For Each x In Range("E9:E37")                                           '遍历单元格
       If x <> "" Then
            Workbooks("原材料下单跟踪表.XLSM").Activate
            Set wb1 = Workbooks("原材料下单跟踪表.XLSM").Worksheets("下单明细")
            EROW = Range("D2").CurrentRegion.Rows.Count + 1                 '判断D列第一个为空的单元格
            j = EROW - 1
            SHT.Activate        '激活工作表
                If Cells(I, "A") <> "" Then
                     Cells(I, "A").Select
                     Selection.Copy
                     wb1.Activate
                     Cells(EROW, "B").Select
                     Selection.PasteSpecial Paste:=xlPasteValues

                     Else
                     wb1.Activate
                     Cells(j, "B").Select
                     Selection.Copy
                     Cells(EROW, "B").Select
                     Selection.PasteSpecial Paste:=xlPasteValues
                End If

            SHT.Activate
            Cells(I, "D").Resize(1, 2).Select
            Selection.Copy
            wb1.Activate
            Cells(EROW, "D").Resize(1, 2).Select
            Selection.PasteSpecial Paste:=xlPasteValues

            SHT.Activate
            Cells("2", "C").Select
            Selection.Copy
            wb1.Activate
            Cells(EROW, "H").Select
            Selection.PasteSpecial Paste:=xlPasteValues

            SHT.Activate
            Cells("46", "H").Select
            Selection.Copy
            wb1.Activate
            Cells(EROW, "F").Select
            Selection.PasteSpecial Paste:=xlPasteValues

            SHT.Activate
            Cells(I, "G").Resize(1, 2).Select
            Selection.Copy
            wb1.Activate
            Cells(EROW, "I").Resize(1, 2).Select
            Selection.PasteSpecial Paste:=xlPasteValues

            SHT.Activate
            Cells("6", "C").Select
            Selection.Copy
            wb1.Activate
            Cells(EROW, "A").Select
            Selection.PasteSpecial Paste:=xlPasteValues
            I = I + 1
            Else
            I = I + 1
      End If

    Next
    Application.ScreenUpdating = True
    Workbooks("原材料下单跟踪表.XLSM").Save
    Workbooks("原材料下单跟踪表.XLSM").Close
End Sub

ggsmart

把无用的代码删掉就显得简洁了，具体可以看《别怕，Excel VBA其实很简单》第7章中的相关内容来了解方法