VBA 別ブックにコピー貼り付けをしたい

Question

前提・実現したいこと

①データの入っているコピー側エクセルのH列、J列、K列、L列、M列、N列の7行目から最終行までをコピーする

②貼り付け側エクセルを開く

③すでにデータの入っている貼り付け側エクセルの最終行より下へ貼り付けをする
コピーした各列の貼り付け先は下記の通りです

H列（コピー元）をB列（貼り付け側）に、J列（コピー元）をG列（貼り付け側）に、K列（コピー元）をH列（貼り付け側）に、
L列（コピー元）をK列（貼り付け側）に、M列（コピー元）をN列（貼り付け側）に、N列（コピー元）をR列（貼り付け側）に、
貼り付けをしたいです

④貼り付けをする前にメッセージボックスで貼り付けしてもいいですかと表示したい

VBA初心者の為、悩むでいます。
アドバイスをよろしくお願い致します。

発生している問題・エラーメッセージ

H列（コピー元）をB列（貼り付け側）に貼り付けまではできましたが、複数のコピペが分かりません。

該当のソースコード

Sub 貼付()
Const xFld As String = "C:\Users\Owner\Desktop\識別表.xlsx"
With ActiveSheet
.Range("H7", .Cells(Rows.Count, 8).End(xlUp)).Copy
End With
With Workbooks.Open(xFld).Worksheets(1)
.Cells(Rows.Count, 2).End(xlUp).Offset(1).PasteSpecial
End With
Application.CutCopyMode = False
End Sub

Comments

[meg_]

列が離れているので処理を繰り返し記述するのが簡単だと思います。

[212111304]

ありがとうございます。
繰り返しの記述がわかなくて、教えて頂けると助かります。

Answer 1

こんにちは。
難しく考えなくとも、以下の方法でいいのでは？と思いました。
私のほうでテストしてみて、うまくいきました。

Option Explicit

Sub 貼付()

  Const xFld As String = "C:\Users\Owner\Desktop\識別表.xlsx"
  
  Dim YesNo As String

  YesNo = MsgBox("貼り付けを開始してもいいですか？", vbYesNo)
  If YesNo = vbNo Then
          MsgBox ("中止します")
          Exit Sub
  End If
  
  Dim CopySheet As Worksheet
  Set CopySheet = ThisWorkbook.Worksheets("sheet1")
  
  Dim PasteSheet As Worksheet
  Set PasteSheet = Workbooks.Open(xFld).Worksheets("sheet1")
  
  With CopySheet
    'コピー側：H列⇒貼り付け側：B列
            .Range("H7", .Cells(Rows.Count, 8).End(xlUp)).Copy
                PasteSheet.Cells(Rows.Count, 2).End(xlUp).Offset(1).PasteSpecial
    
    'コピー側：J列⇒貼り付け側：G列
            .Range("J7", .Cells(Rows.Count, 10).End(xlUp)).Copy
                PasteSheet.Cells(Rows.Count, 7).End(xlUp).Offset(1).PasteSpecial
    
    'コピー側：K列⇒貼り付け側：H列
            .Range("K7", .Cells(Rows.Count, 11).End(xlUp)).Copy
                PasteSheet.Cells(Rows.Count, 8).End(xlUp).Offset(1).PasteSpecial
    
    'コピー側：L列⇒貼り付け側：K列
            .Range("L7", .Cells(Rows.Count, 12).End(xlUp)).Copy
                PasteSheet.Cells(Rows.Count, 11).End(xlUp).Offset(1).PasteSpecial
    
    'コピー側：M列⇒貼り付け側：N列
            .Range("M7", .Cells(Rows.Count, 13).End(xlUp)).Copy
                PasteSheet.Cells(Rows.Count, 14).End(xlUp).Offset(1).PasteSpecial
    
    'コピー側：N列⇒貼り付け側：R列
            .Range("N7", .Cells(Rows.Count, 14).End(xlUp)).Copy
                PasteSheet.Cells(Rows.Count, 18).End(xlUp).Offset(1).PasteSpecial
  End With

End Sub

ご参考になれば幸いです。