VBA 既に開いているBookに継続作業（転記）する追加コード

データを別ブックに転記するマクロをこちらでご教示頂きました。

今、各sheetのデータを順にsheetごと（Ｙ列にデータがある場合）実行ボタンで別Bookの空白行に転記しております。（転記ファイルは１つ）

sheet1で下記コードで実行しbookを開き、sheet2で同じく実行すると「二重でひらくと・・・」と警告が出ますが「開いている場合、そのまま作業を継続」するコードを追加出来ないでしょうか？

--------------------------------------------------------------------
Sub 集計転記()

Dim wb As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set wb = Workbooks.Open("Filepath")
Set ws1 = ThisWorkbook.Worksheets("転記元")
Set ws2 = wb.Worksheets("転記先")

'ws2の貼り付け位置
x = ws2.Range("B9").End(xlDown).Row
If x = Rows.Count Then x = 10 Else x = x + 1

'シートを指定してデータを転記
ws2.Range("A" & x & ":AE" & x + 15).Value = ws1.Range("A10:AE50").Value
--------------------------------------------------------------------

No.1 ベストアンサー 回答者： Qchan1962 回答日時： 2020/10/28 17:42

こんばんは、

＞"Filepath"　これは、パスが入っているで良いのでしょうか？

開いているかを調べて処理を分ければ良いと思います。
よく使う方法

Dim wb As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
On Error Resume Next
Open "Filepath" For Append As #1
Close #1
If Err.Number > 0 Then
Set wb = Workbooks("対象.xlsx")
Else
Set wb = Workbooks.Open("Filepath")
End If
On Error GoTo 0

Set ws1 = ThisWorkbook.Worksheets("転記元")
Set ws2 = wb.Worksheets("転記先")

＞sheet2で同じく実行すると
これって、ws1変えなくて良いのかな？考えすぎかな。

この回答へのお礼

Qchan1962様
おはようございます。
出社し実装いたしましたところ、無事作動致しました。

VBAで出来ることに興味を持ち始め色々とトライしこちらで
助けて頂いております。
また何かありましたらよろしくお願いいたします。

ありがとうございました。

お礼日時：2020/10/29 10:29