|
▼ケメ子 さん:
こんにちは
サーバーのパス名を適切なものに変更した上でお試しください。
元ブック側のG6からの行数が変動するわけで、残念ながら、元ブックも開きます。
Sub Sample2()
Dim fPath As String '元ブックのサーバパス
Dim tPath As String '先ブックのサーバパス
Dim z As Long
Dim shn As Variant
Dim myFso As Object
Dim myFiles As Object
Dim myFile As Object
Dim tCell As String
Dim fName As String
Dim fBook As Workbook
Dim tBook As Workbook
Application.ScreenUpdating = False
Set myFso = CreateObject("Scripting.FileSystemObject")
fPath = "c:\Test1" '実際のサーバパス名に
tPath = "c:\Test2" '実際のサーバパス名に
For Each myFile In myFso.GetFolder(tPath).Files
fName = "【作業】" & myFile.Name
If LCase(myFso.GetExtensionName(myFile.Name)) = "xls" And _
myFso.FileExists(fPath & "\" & fName) Then
Set fBook = Workbooks.Open(fPath & "\" & fName)
Set tBook = Workbooks.Open(tPath & "\" & myFile.Name, Password:="abc")
For Each shn In Array("A", "B", "C", "D")
Select Case shn
Case "A"
tCell = "P5"
Case "B"
tCell = "C5"
Case "C"
tCell = "V5"
Case "D"
tCell = "N5"
End Select
z = fBook.Sheets(shn).Range("G6").End(xlDown).Row - 5
tBook.Sheets(shn).Range(tCell).Resize(z).Value = _
fBook.Sheets(shn).Range("G6").Resize(z).Value
Next
tBook.Close True
fBook.Close False
End If
Next
Set myFso = Nothing
Set fBook = Nothing
Set tBook = Nothing
Application.ScreenUpdating = True
MsgBox "処理が終了しました。"
End Sub
|
|