Sub 測試()
Dim Wb As Workbook, sh As String, x As Range
' Set Wb = Workbooks(Workbooks("Macro.xlsm").Worksheets("VBA").Range("B1").Value) '儲存格的值為檔案名稱
sh = Worksheets("VBA").Range("B2") '儲存格的值為工作表名稱
Worksheets(sh).Activate
With Worksheets(sh)
Set x = .Range("B4")
x = Worksheets("VBA").Range("B4").Value '指定1.sheet日期
End With
End Sub
Sub 測試()
Dim Wb As Workbook, Sh As Worksheet, x As Range, Source1 As String
Source1 = Workbooks("Macro.xlsm").Worksheets("VBA").Range("B1").Value '要開啟的檔案名稱
Workbooks.Open "c:\A\" & Source1 & ".xlsx" '開啟要寫入的檔案
Workbooks("Macro.xlsm").Activate
Set Wb = Workbooks(Workbooks("Macro.xlsm").Worksheets("VBA").Range("B1").Value) '儲存格的值為檔案名稱
Set Sh = Wb.Worksheets(Worksheets("VBA").Range("B2").Text) '儲存格的值為工作表名稱,因為工作表名稱是數字,會被當成"數第N個工作表",還無法解決,以加1先暫用
Sh.Activate
With Sh
Set x = Sh.Range(Workbooks("Macro.xlsm").Worksheets("VBA").Range("B5").Text) '指定寫入的儲存格為放在那個欄位
x = Workbooks("Macro.xlsm").Worksheets("VBA").Range("B4").Text '寫人的值放在那個欄位
End With
Workbooks(Dir("C:\A\" & Source1 & ".xlsx")).Close True '關閉並儲存寫入的檔案
End Sub
Sub 測試()
Dim P$, S$, T$, R$, F$, N&, xA As Range, xB As Workbook, xS As Worksheet
P = [B6]: If P = "" Then MsgBox "**子資料夾未輸入! ": Exit Sub
P = ThisWorkbook.Path & "\" & P & "\"
If Dir(P, vbDirectory) = "" Then MsgBox "**子資料夾不存在! ": Exit Sub
S = [B2]: If S = "" Then MsgBox "**工作表名稱未輸入! ": Exit Sub
T = [B4].Text: If S = "" Then MsgBox "**寫入的內容未輸入! ": Exit Sub
R = [B5]: If R = "" Then MsgBox "**寫入位址未輸入! ": Exit Sub
On Error Resume Next: Set xA = Range(R): On Error GoTo 0
If xA Is Nothing Then MsgBox "**寫入位址不正確! ": Exit Sub
If xA.Count > 1 Then MsgBox "**寫入位址不是單一儲存格! ": Exit Sub
'--------------------------------------------------------------------
[F1:H999].ClearContents: Set xA = [F1]
Application.ScreenUpdating = False
Do
If F = "" Then F = Dir(P & "*.xls") Else F = Dir() 'xls 自行改成 xlsx
If F = "" Then Exit Do
N = N + 1: xA = N: xA(1, 2) = F: xA(1, 3) = "(X)工作表不存在"
Set xB = Workbooks.Open(P & F): Set xS = Nothing
On Error Resume Next: Set xS = xB.Sheets(S): On Error GoTo 0
If Not xS Is Nothing Then xS.Range(R) = T: xB.Save: xA(1, 3) = "(V)寫入完成"
Set xA = xA(2): xB.Close 0
Loop
End Sub
發表於 2019-4-21 16:23
| 
發表於 2019-4-27 11:43
| 
