|
こんな感じかな ?
Sub Sh_Copy()
Dim WB As Workbook, MyB As Workbook
Application.ScreenUpdating = False
If Workbooks.Count > 1 Then
For Each WB In Workbooks
If WB.Name <> ThisWorkBook.Name Then
WB.Close True
End If
Next
End If
With ThisWorkBook
.Worksheets("Sheet1").UsedRange.Copy
Set MyB = Workbooks.Open(.Path & "\B.xls")
MyB.Worksheets("Sheet1").Range("A1").PasteSpecial
MyB.Close True: Set MyB = Nothing
Set MyB = Workbooks.Open(.Path & "\C.xls")
End With
MyB.Worksheets("Sheet1").Range("A1").PasteSpecial
MyB.Close True: Set MyB = Nothing
With Applicatin
.CutCopyMode = False
.ScreenUpdating = True
End With
MsgBox "コピー処理を終了しました", 64
End Sub
|
|