Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

51157 / 76732

←次へ　｜　前へ→


	【30449】Re:別ブックのシートを統合したい

Statis - 05/10/27(木) 20:25 -


	引用なし

	パスワード

こんばんは
もっと良い方法があるような気がしますが？
お試しを（すべてThisWorkbookのモジュールです）

Dim Ch As Long
Private Sub Workbook_BeforeClose(Cancel As Boolean)

If Ch = 2 Then
　 Call Wb_Open
End If
End Sub
Private Sub Workbook_Open()
　Ch = 1
　Call Wb_Open
　Ch = 2

End Sub

Private Sub SheetAddandCopy(sFileName As Variant)

Dim Wb1 As Workbook
Set Wb1 = Workbooks.Open(ThisWorkbook.Path & "\" & sFileName, ReadOnly:=True)
Wb1.Worksheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Workbooks(sFileName).Close False
Set Wb1 = Nothing

End Sub

Private Sub Wb_Open()

Dim Da As Variant, Co1 As Long
　Application.ScreenUpdating = False
　Co1 = 1
　For Each Da In Array("Meibo.xls", "PrintForm.xls")
　　 If Ch = 1 Then
　　　　SheetAddandCopy Da
　　 Else
　　　　wb_Close Da, Co1
　　　　Co1 = 0
　　 End If
　Next Da
　Ch = 3
　Application.ScreenUpdating = True

End Sub

Private Sub wb_Close(sFileName As Variant, Co As Long)

Dim Wb1 As Workbook
Set Wb1 = Workbooks.Open(ThisWorkbook.Path & "\" & sFileName)
Application.DisplayAlerts = False
With ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count - Co)
　　 .Cells.Copy Wb1.Worksheets(1).Range("A1")
　　 .Delete
End With
Workbooks(sFileName).Close True
Application.DisplayAlerts = True
Set Wb1 = Nothing

End Sub

1 hits

▼

【30402】別ブックのシートを統合したい VBA初心者　丸助 05/10/26(水) 19:02