|
▼ケメ子 さん:
ごめんなさい
単純なミスでした。
行数把握をxlUpでやっていたつもりでしたが、実際のコードはxlDown。
xlUpベースに直しました。
Option Explicit
Sub Sample3()
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
Dim xlRowMax As Long
Application.ScreenUpdating = False
Set myFso = CreateObject("Scripting.FileSystemObject")
fPath = "c:\Test1" '実際のサーバパス名に
tPath = "c:\Test2" '実際のサーバパス名に
xlRowMax = Rows.Count
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
With tBook.Worksheets(shn)
.Range(tCell & ":" & Split(.Range(tCell).Address, "$")(1) & xlRowMax).ClearContents
z = fBook.Sheets(shn).Range("G" & xlRowMax).End(xlUp).Row
If z >= 6 Then
.Range(tCell).Resize(z - 5).Value = _
fBook.Sheets(shn).Range("G6").Resize(z - 5).Value
End If
End With
Next
tBook.Close True
fBook.Close False
End If
Next
Set myFso = Nothing
Set fBook = Nothing
Set tBook = Nothing
Application.ScreenUpdating = True
MsgBox "処理が終了しました。"
|
|