| |
▼ケメ子 さん：
追加です。
もし、いったん先ブックに反映させた後、なんらかの理由で元ブックを変更し
あらためて先ブックに反映させるケースがあるとして、この時、元ブック側の
行数が減少していると、元ブックにある行数のみ転記する結果、先ブックに
前回転記されたものが、残ってしまう可能性がありますね。
このようなケースがありえ、それを回避するということなら、上で連絡した
転記データ有無のチェックも加味すると、以下のようなコードに。
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
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
With tBook.Worksheets(shn)
.Range(tCell & ":" & Split(.Range(tCell).Address, "$")(1) & .Rows.Count).ClearContents
z = fBook.Sheets(shn).Range("G6").End(xlDown).Row - 5
If z >= 6 Then
.Range(tCell).Resize(z).Value = _
fBook.Sheets(shn).Range("G6").Resize(z).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 "処理が終了しました。"
End Sub
|
|
UO3
- 11/1/7(金) 9:17 -
