- 帖子
- 2035
- 主題
- 24
- 精華
- 0
- 積分
- 2031
- 點名
- 0
- 作業系統
- Win7
- 軟體版本
- Office2010
- 閱讀權限
- 100
- 性別
- 男
- 註冊時間
- 2012-3-22
- 最後登錄
- 2024-2-1
|
本帖最後由 c_c_lai 於 2012-4-29 06:42 編輯
回復 19# PJChen
這是不是妳要的?
- Sub Try()
- Dim Rng(1 To 2) As Range
-
- Windows("PKG.xlsx").Activate
- ' 加入 Hsieh 先進的引用方法
- With Workbooks("PKG.xlsx")
- With .Sheets("PKG")
- Set Rng(1) = .Range("D:D").Find("Shipped per SS:", LOOKAT:=xlPart)
- Set Rng(2) = .Range("D:D").Find("PACKING:")
-
- If Rng(1) Is Nothing Or Rng(2) Is Nothing Then
- MsgBox "找不到"
- Else ' 依照 Hsieh 先進的指示,稍加修飾
- .Range(Rng(1), Rng(2).Offset(, 11)) = .Range(Rng(1), Rng(2)).Resize(, 12).Value
- End If
- End With
- End With
-
-
- Selection.Copy
- Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
- :=False, Transpose:=False
- Range("Q122:Q122").Select
- Selection.Copy
- Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
- :=False, Transpose:=False
- ActiveSheet.Paste
- Rows("143:143").Select
- Selection.ClearContents
- Range("C1").Select
-
- ActiveWorkbook.SaveAs "D:\Shipping Doc\PJ\" & [Q5] & "_" & [C6] & " PO#" & [V7] & " by " & [C19] & " to " & [C22] & ".xlsx"
-
- Sheets("PKG").Select ' 恢復原狀
- Columns("R:AC").Select ' 恢復原狀
- Selection.Delete Shift:=xlToLeft ' 恢復原狀
- Columns("A:C").Select
- Range("C11").Activate
- Selection.Delete Shift:=xlToLeft
-
- ActiveWorkbook.Save
- End Sub
複製代碼
VBA TEST.rar (55.82 KB)
|
|