准提部林

假如資料這麼有規則．參考：

1. Sub Macro1()
   
2. Dim xU As Range
   
3. Sheets("PKG").UsedRange.Copy [工作表2!A1] '貼入全部資料
   
4. Set xU = [工作表2!D:D].SpecialCells(xlCellTypeConstants, 2) '取得"PC"字樣全部儲存格
   
5. xU.Offset(1, -3).ClearContents '清除[箱號]下方數字
   
6. With xU.Offset(, -2)
   
7. 　　　.Item(1).Delete Shift:=xlUp 'B欄上移一格
   
8. 　　　.EntireRow.Delete '刪去列
   
9. End With
   
10. End Sub

複製代碼

或：

1. Sub Macro2()
   
2. Sheets("PKG").UsedRange.Copy [工作表2!A1]
   
3. With [工作表2!D:D].SpecialCells(xlCellTypeConstants, 2).Offset(, -2)
   
4. 　　　.Offset(1, -1).ClearContents '清除[箱號]下方數字
   
5. 　　　.Item(1).Delete Shift:=xlUp 'B欄上移一格
   
6. 　　　.EntireRow.Delete '刪去列
   
7. End With
   
8. End Sub

複製代碼