麻辣家族討論版版 - Powered by Discuz! Board

Sub 庫存更新()
'
'
'
'
Dim Msg As Boolean, W As Workbook, Wb As Workbook 'W As "來源檔" Wb As "目的檔"
'Boolean 型態的預設值為 False
'*******Workbooks 開啟的活頁簿物件集合****
For Each W In Workbooks
If UCase(W.Name) = UCase("庫存資料表.xlsx") Then 'UCase的功能是什麼?
Msg = True '檔案已開啟
Exit For
End If
Next
'*****************************************
If Msg = True Then '檔案已開啟
Set W = Workbooks("庫存資料表.xlsx")
Else '檔案尚未打開時
Set W = Workbooks.Open("Q:\00_科毅\出貨文件連結\FromERP\庫存資料表.xlsx")
End If
'*****************************************
If Msg = True Then '檔案已開啟
Set Wb = Workbooks("ERP_Data.xlsx")
Else '檔案尚未打開時
Set Wb = Workbooks.Open("Q:\00_科毅\出貨文件連結\ERP_Data.xlsx")
End If
'*****************************************Sorting以.Range("L1")為首
Windows("庫存資料表.xlsx").Activate
Range("G1").Select
Selection.AutoFilter '建立自動篩選
Range("G2").Select
ActiveWindow.FreezePanes = True '凍結window
'ActiveWindow.FreezePanes = False '取消凍結window
With Workbooks("庫存資料表.xlsx")
With .Sheets("庫存資料表")
Set b = .Range("L1").CurrentRegion
A = Array("L", "F") '若有其他Sorting順位也可加入
.AutoFilter.Sort.SortFields.Clear
For i = 0 To 1 '指A = Array("L", "F") 有幾個sorting項目,2個就是0 To 1
.AutoFilter.Sort.SortFields.Add Key:=b.Columns(A(i)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
Next
With .AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End With
W.Save
'Workbooks("庫存資料表.xlsx").Close True '存檔後關閉檔案
'*****************************************
With W.Sheets("庫存資料表")
Set A = Intersect(.UsedRange, .Range("A:AA")).SpecialCells(xlCellTypeVisible) '只選擇有資料的範圍
End With
With Wb
'a.Copy .Sheets("庫存").Range("B1") '完全複製到sheet的B1
'*************************************
A.Copy
.Sheets("庫存").Range("B1").PasteSpecial xlPasteValues '選擇性貼上值
'*************************************
Application.CutCopyMode = False '***不處於剪下或複製模式
'.Close True '目的檔存檔後關閉檔案
Wb.Save '目的檔存檔
End With
W.Close False '來源檔關閉檔案(不會問是否存檔)
End Sub

複製代碼

Option Explicit
Dim 目的檔 As Workbook, 來源檔 As Workbook
Sub 庫存更新()
Dim xRng As Range
File_settings 來源檔, "庫存資料表.xlsx"
File_settings 目的檔, "ERP_Data.xlsx"
With 來源檔.Sheets(1)
.Cells.Sort Key1:=.Columns("L"), Key2:=.Columns("F"), Header:=xlYes
Set xRng = .UsedRange 'UsedRange->工作表所使用的範圍,如A:AA之後再也沒資料
xRng.Copy 'A:AA複製到目的檔B:AB
End With
With 目的檔.Sheets("庫存")
.Range("B1").PasteSpecial xlPasteValues '選擇性貼上值
'自動清除目的檔1065:1073列
.Range("a" & xRng.Rows.Count + 1, .Range("A1101")).Resize(, 27).Clear
End With
來源檔.Close False
目的檔.Save
End Sub
Sub File_settings(xFile As Workbook, 工作頁 As String) '檔案設定
Dim xPath As String
xPath = ThisWorkbook.Path & "\"
If UCase(工作頁) <> UCase("ERP_Data.XLSX") Then xPath = xPath & "FromERP\"
On Error Resume Next
Set xFile = Workbooks(工作頁)
If Err > 0 Then Set xFile = Workbooks.Open(xPath & 工作頁)
If xFile.Name = "" Then
MsgBox "請查看 " & vbLf & xPath & vbLf & "是否有 [" & 工作頁 & "]"
End
End If
End Sub

複製代碼

Option Explicit
Dim 目的檔 As Workbook, 來源檔 As Workbook
Sub 庫存更新()
Dim xRng As Range
File_settings 來源檔, "庫存資料表.xlsx"
File_settings 目的檔, "ERP_Data.xlsx"
Set xRng = 來源檔.Sheets(1).UsedRange 'UsedRange->工作表所使用的範圍,如A:AA之後再也沒資料
'來源檔第一個工作表,排序 1) L 2)F
With 來源檔.Sheets(1).Range("A:AA")
.Cells.Sort Key1:=.Columns("L"), Key2:=.Columns("F"), _
Header:=xlYes
xRng.Copy 'A:AA複製到目的檔B:AB
With 目的檔.Sheets("庫存")
.Range("B1").PasteSpecial xlPasteValues '選擇性貼上值
'自動清除目的檔1065:1073列
.Range("a" & xRng.Rows.Count + 1, .Range("A1101")).Resize(, 37).Clear
End With
End With
來源檔.Close False '來源檔關閉檔案(不會問是否存檔)
目的檔.Save
End Sub
Sub File_settings(xFile As Workbook, 工作頁 As String) '檔案設定
Dim xPath As String
xPath = ThisWorkbook.Path & "\"
If UCase(工作頁) <> UCase("ERP_Data.XLSX") Then xPath = xPath & "FromERP\"
On Error Resume Next
Set xFile = Workbooks(工作頁)
If Err > 0 Then Set xFile = Workbooks.Open(xPath & 工作頁)
If xFile.Name = "" Then
MsgBox "請查看 " & vbLf & xPath & vbLf & "是否有 [" & 工作頁 & "]"
End
End If
End Sub

複製代碼

File_settings 來源檔, "庫存資料表.xlsx"
File_settings 目的檔, "ERP_Data.xlsx"
'**********來源檔是同VBA報表指令的資料夾\FromERP\*********
If UCase(工作頁) <> UCase("ERP_Data.XLSX") Then xPath = xPath & "FromERP\"

複製代碼

Option Explicit
Dim 目的檔 As Workbook, 來源檔 As Workbook
Sub 庫存更新()
Dim xRng As Range
File_settings 來源檔, "庫存資料表.xlsx"
File_settings 目的檔, "ERP_Data.xlsx"
'*********************************************************
With 來源檔.Sheets(1)
Set xRng = .UsedRange 'UsedRange->工作表所使用的範圍,如A:AA之後再也沒資料
xRng.Copy 'A:AA複製到目的檔B:AB
End With
With 目的檔.Sheets("庫存")
.Range("B1").PasteSpecial xlPasteValues '選擇性貼上值
.Range("a" & xRng.Rows.Count + 1, .Range("A1101")).Resize(, 37).Clear
.Cells.Sort Key1:=.Columns("AD"), Key2:=.Columns("G"), Header:=xlYes
End With
來源檔.Close False
目的檔.Save
End Sub
'**********來源檔是同VBA報表指令的資料夾\FromERP\*********
Sub File_settings(xFile As Workbook, 工作頁 As String) '檔案設定
Dim xPath As String
xPath = ThisWorkbook.Path & "\"
If UCase(工作頁) <> UCase("ERP_Data.XLSX") Then xPath = xPath & "FromERP\"
On Error Resume Next
Set xFile = Workbooks(工作頁)
If Err > 0 Then Set xFile = Workbooks.Open(xPath & 工作頁)
If xFile.Name = "" Then
MsgBox "請查看 " & vbLf & xPath & vbLf & "是否有 [" & 工作頁 & "]"
End
End If
End Sub

複製代碼

Option Explicit
Dim 目的檔 As Workbook, 來源檔 As Workbook
Sub sorting()
Dim xRng As Range
File_settings 目的檔, "ERP_Data.xlsx"
With 目的檔.Sheets("庫存")
.Cells.Sort Key1:=.Columns("AD"), Key2:=.Columns("G"), Header:=xlYes
End With
目的檔.Save
End Sub
'**********來源檔是同VBA報表指令的資料夾\FromERP\*********
Sub File_settings(xFile As Workbook, 工作頁 As String) '檔案設定
Dim xPath As String
xPath = ThisWorkbook.Path & "\"
If UCase(工作頁) <> UCase("ERP_Data.XLSX") Then xPath = xPath & "FromERP\"
On Error Resume Next
Set xFile = Workbooks(工作頁)
If Err > 0 Then Set xFile = Workbooks.Open(xPath & 工作頁)
If xFile.Name = "" Then
MsgBox "請查看 " & vbLf & xPath & vbLf & "是否有 [" & 工作頁 & "]"
End
End If
End Sub

複製代碼

Option Explicit
Dim 目的檔 As Workbook, 來源檔 As Workbook
Sub 庫存更新()
Dim xRng As Range
File_settings 來源檔, "庫存資料表.xlsx"
File_settings 目的檔, "ERP_Data.xlsx"
'*********************************************************
With 來源檔.Sheets(1)
Set xRng = .UsedRange 'UsedRange->工作表所使用的範圍,如A:AA之後再也沒資料
xRng.Copy 'A:AA複製到目的檔B:AB
End With
With 目的檔.Sheets("庫存")
.Range("B1").PasteSpecial xlPasteValues '選擇性貼上
End With
With 目的檔.Sheets("庫存")
.Cells.Sort Key1:=.Columns("AD"), Key2:=.Columns("G"), Header:=xlYes
End With
來源檔.Close False
目的檔.Save
End Sub
'**********來源檔是同VBA報表指令的資料夾\FromERP\*********
Sub File_settings(xFile As Workbook, 工作頁 As String) '檔案設定
Dim xPath As String
xPath = ThisWorkbook.Path & "\"
If UCase(工作頁) <> UCase("ERP_Data.XLSX") Then xPath = xPath & "FromERP\"
On Error Resume Next
Set xFile = Workbooks(工作頁)
If Err > 0 Then Set xFile = Workbooks.Open(xPath & 工作頁)
If xFile.Name = "" Then
MsgBox "請查看 " & vbLf & xPath & vbLf & "是否有 [" & 工作頁 & "]"
End
End If
End Sub

複製代碼