- 帖子
- 559
- 主題
- 58
- 精華
- 0
- 積分
- 626
- 點名
- 0
- 作業系統
- win8
- 軟體版本
- office2013
- 閱讀權限
- 50
- 性別
- 男
- 來自
- TW
- 註冊時間
- 2010-11-22
- 最後登錄
- 2024-6-14
|
回復 1# koala2099 - Private Sub CommandButton1_Click()
- '======篩選有幾個倉庫===========
- Sheet1.Range("B2:B65536").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheet1.Range( _
- "P2"), Unique:=True
-
- A = Sheet1.Range("P65536").End(xlUp).Row '共有幾個倉庫
- B = Sheet1.Range("C65536").End(xlUp).Row '共有多少筆資料要被執行
- With Application.FileDialog(msoFileDialogFolderPicker)
- If .Show = 0 Then Exit Sub
- patch = .SelectedItems(1)
- Application.DefaultFilePath = patch
- If .ButtonName = "確定" Then
- For I = 2 To A
- Workbooks.Add
- ActiveWorkbook.Sheets(1).Name = Sheet1.Range("P" & I)
- With ActiveWorkbook
- Sheet1.Range("A1:J1").Copy .Sheets(1).Range("A1")
- For J = 2 To B
- If Sheet1.Range("P" & I) = Sheet1.Range("B" & J) Then
- .Sheets(1).Range("A" & 2 + N) = Sheet1.Range("A" & J)
- .Sheets(1).Range("B" & 2 + N) = Sheet1.Range("B" & J)
- .Sheets(1).Range("C" & 2 + N) = Sheet1.Range("C" & J)
- .Sheets(1).Range("D" & 2 + N) = Sheet1.Range("D" & J)
- .Sheets(1).Range("E" & 2 + N) = Sheet1.Range("E" & J)
- .Sheets(1).Range("F" & 2 + N) = Sheet1.Range("F" & J)
- .Sheets(1).Range("G" & 2 + N) = Sheet1.Range("G" & J)
- .Sheets(1).Range("H" & 2 + N) = Sheet1.Range("H" & J)
- .Sheets(1).Range("I" & 2 + N) = Sheet1.Range("I" & J)
- .Sheets(1).Range("J" & 2 + N) = Sheet1.Range("J" & J)
- N = N + 1
- End If
- Next
- .SaveAs Application.DefaultFilePath & "\" & Sheet1.Range("P" & I)
- .Close
- End With
- N = 0
- Next
- End If
- End With
- Sheet1.Range("P:P").Delete
- ActiveWorkbook.Save
- End Sub
複製代碼 |
|