|
▼Kein さん:
ありがとうございます。
コピーは出来たのですが、エラーが出てきてしまいます。
御忙しい所、申し訳ございませんが
マイドキュメントのファイルはどうやったら、良いか教えて頂けますでしょうか。
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 & "\Book1.xls")
MyB.Worksheets("Sheet1").Range("A1").PasteSpecial
MyB.Close True: Set MyB = Nothing
Set MyB = Workbooks.Open(.Path & "\Book2.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
どこを直した宜しいでしょうか。
申し訳ございません。教えて頂けますでしょうか。
>こんな感じかな ?
>
>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
|
|