別ブックの空白行に転記

別シートへ指定セルを転記するコードで下記のように教示して頂き使用してます。
これを「別ブック」のシートに同じ様式に転記するように出来たらと思っております。

------------------------------------------------------------------
'----------------------------------------
'別sheetへ転記
'----------------------------------------

Sub 転記_sheet()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Worksheets("転記元")
Set ws2 = Worksheets("転記先")

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

'②シートを指定してデータを転記
ws2.Range("B" & x & ":C" & x + 15).Value = ws1.Range("A10:B25").Value
ws2.Range("D" & x & ":D" & x + 15).Value = ws1.Range("P10:P25").Value
ws2.Range("E" & x & ":E" & x + 15).Value = ws1.Range("R10:R25").Value
ws2.Range("F" & x & ":F" & x + 15).Value = ws1.Range("Y10:Y25").Value
ws2.Range("G" & x & ":G" & x + 15).Value = ws1.Range("U10:UG25").Value

End Sub
------------------------------------------------------------------


以下のコードではブックは開きますが転記出来ません。

------------------------------------------------------------------

'----------------------------------------
'別bookへ転記
'----------------------------------------

Sub 転記_Book()

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

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

'②シートを指定してデータを転記
ws2.Range("B" & x & ":C" & x + 15).Value = ws1.Range("A10:B25").Value
ws2.Range("D" & x & ":D" & x + 15).Value = ws1.Range("P10:P25").Value
ws2.Range("E" & x & ":E" & x + 15).Value = ws1.Range("R10:R25").Value
ws2.Range("F" & x & ":F" & x + 15).Value = ws1.Range("Y10:Y25").Value
ws2.Range("G" & x & ":G" & x + 15).Value = ws1.Range("U10:UG25").Value

End Sub
------------------------------------------------------------------

ご教示頂ければと思っております。
よろしくお願いいたします。

No.5 ベストアンサー 回答者： fujillin 回答日時： 2020/10/22 17:37

No3です

補足をよく見たら、ws1の設定も一緒に移動しちゃっているようですけれど、「転記元シート」も別ブック内のシートのおつもりでしょうか？？
それなら、それで良いのですが・・・。

もしも、ご質問が『元のブックのシートの値を、別のブックのシートに転記』したいという意味なら、
＞Set wb = Workbooks.Open("パス")
＞Set ws1 = Worksheets("転記元")
＞Set ws2 = ws.Worksheets("転記先")

ではなく、最初に記した通りに、

＞wbを開いてから　Set ws2 = wb.Worksheets("転記先")
とすれば良いでしょう。
　Set ws1 = Worksheets("転記元")
　Set wb = Workbooks.Open("パス")
　Set ws2 = wb.Worksheets("転記先")

あるいは、どうしても補足の記載順に記したいのであれば、ブックを明示して、
　Set wb = Workbooks.Open("パス")
　Set ws1 = ThisWorkbook.Worksheets("転記元")
　Set ws2 = wb.Worksheets("転記先")
のようにするとか。

※ いずれにしろ、該当するシートが存在しなければエラーになります。

この回答へのお礼

ご回答ありがとうございます。
ご質問の通り「元のブックのシートの値」です。
これから月曜日まで検証できる環境では無いので改めまして確認致します。
ありがとうございます。

お礼日時：2020/10/22 18:09

No.4 回答者： Qchan1962 回答日時： 2020/10/22 17:16

こんばんは、

別ブックに転記するのなら、setの仕方が違うような気がします。
違うかも知れませんが、
Set ws1 = Worksheets("転記元")
Set ws2 = Worksheets("転記先")
これは、マクロ実行ブックのシートを指します。転記先名のシートが無ければ、インデックス。。。です。

なので、
Set wb = Workbooks.Open("path")
Set ws1 = ThisWorkbook.Worksheets("転記元")
Set ws2 = wb.Worksheets("転記先")

Set ws1 =マクロ実行ブックの転記元シート
Set ws2 =別ブックの転記先シート

Workbooks.Open("path")で別ブックが開いた直後であれば
Set ws2 = wb.Worksheets("転記先")は、
Set ws2 =ActiveWorkbook.Worksheets("転記先")でも良いかと

どうでしょう？

この回答へのお礼

これから月曜日まで検証できる環境では無いので改めまして確認致します。
ありがとうございます。

お礼日時：2020/10/22 18:09

No.3 回答者： fujillin 回答日時： 2020/10/22 16:18

No2です

＞「インデックスが有効範囲にありません」のエラーは変わらずです。
どこでエラーが発生しているのか不明ですが、ご提示の内容から想像するところ、怪しそうなのは以下あたりでしょうか。
エラー発生行に当てはめてお調べください。
　・指定したシートが存在しない（No1にも記しましたが）
　・セル位置の指定の変数xの値がおかしい

No.2 回答者： fujillin 回答日時： 2020/10/22 14:15

No1です

ごめんなさい。
No1で書き間違えをしていました。

誤：ws.Worksheets("転記先")

正：wb.Worksheets("転記先")

ですね。
すみませんでした。

この回答へのお礼

再度ありがとうございます。

以下に変更しましたが「インデックスが有効範囲にありません」のエラーは変わらずです。

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


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

'②シートを指定してデータを転記
ws2.Range("B" & x & ":C" & x + 15).Value = ws1.Range("A10:B25").Value
ws2.Range("D" & x & ":D" & x + 15).Value = ws1.Range("P10:P25").Value
ws2.Range("E" & x & ":E" & x + 15).Value = ws1.Range("R10:R25").Value
ws2.Range("F" & x & ":F" & x + 15).Value = ws1.Range("Y10:Y25").Value
ws2.Range("G" & x & ":G" & x + 15).Value = ws1.Range("U10:UG25").Value

他の原因はありますでしょうか？

お礼日時：2020/10/22 16:13

No.1 回答者： fujillin 回答日時： 2020/10/22 11:15

こんにちは

転記先がws2なのですから、
＞Set ws2 = Worksheets("転記先")
では、ThisWorkbookの「転記先シート」に設定されています。

wbを開いてから
　Set ws2 = ws.Worksheets("転記先")
のようにすれば、開いたブックの「転記先シート」の意味になります。
（転記先シートが存在しない場合はエラーになりますのでご注意）

この回答へのお礼

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

>wbを開いてから
>　Set ws2 = ws.Worksheets("転記先")
>のようにすれば、開いたブックの「転記先シート」の意味になります。

↓
Dim wb As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set wb = Workbooks.Open("パス")
Set ws1 = Worksheets("転記元")
Set ws2 = ws.Worksheets("転記先")

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

'シートを指定してデータを転記
ws2.Range("B" & x & ":C" & x + 15).Value = ws1.Range("A10:B25").Value
ws2.Range("D" & x & ":D" & x + 15).Value = ws1.Range("P10:P25").Value
ws2.Range("E" & x & ":E" & x + 15).Value = ws1.Range("R10:R25").Value
ws2.Range("F" & x & ":F" & x + 15).Value = ws1.Range("Y10:Y25").Value
ws2.Range("G" & x & ":G" & x + 15).Value = ws1.Range("U10:UG25").Value

↑↑「インデックスが有効範囲にありません」とエラーになります。

お礼日時：2020/10/22 13:41