別ブックの空白行に転記

Question

別シートへ指定セルを転記するコードで下記のように教示して頂き使用してます。
これを「別ブック」のシートに同じ様式に転記するように出来たらと思っております。

------------------------------------------------------------------
'----------------------------------------
'別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
------------------------------------------------------------------

ご教示頂ければと思っております。
よろしくお願いいたします。

fujillin · Accepted Answer

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("転記先")
のようにするとか。

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

Qchan1962 · Answer

こんばんは、
別ブックに転記するのなら、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("転記先")でも良いかと

どうでしょう？

fujillin · Answer

No2です

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

fujillin · Answer

No1です

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

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

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

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

fujillin · Answer

こんにちは

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

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

別ブックの空白行に転記

No3です

こんばんは、

No2です

No1です

こんにちは

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング