ウーム、なぜ転置してしまったのか今となっては不明です。白昼夢でしたか。
まず最初に追加質問への回答から。
「この選択された状態を解除して」は、
貼り付けたあとに、
Application.CutCopyMode = False
を入れるとよいでしょう。
以下は、再質問を読む前に書いておいたものに、貼り付け部分の修正をしたものです。
【訂正】
説明も無しに、[A1]という書き方をしたので戸惑ったかもしれません。
Application.Goto ws.[A1]
は、
Application.Goto ws.Range("A1") と書くのと同じです。
なお、これはBookをアクティブにし、シートをアクティブにし、セルを選択する動作を、
1文ですますものです。(決まり文句(jargon)のようなものと思って下さい)
【補足1】
普通は下記のようにBookをアクティベイトします。しかし、画面がちらつきます。 wb.Activate
r = ActiveCell.Row Application.ScreenUpdating = False などとして 画面更新抑止してもちらつきます。
これをちらつかないようにするには、下記のようにするといいでしょう。
r = wb.Windows(1).ActiveCell.Row
【補足2】
転記元セルは、
Set rng = Union(Cells(r, "A").Resize(1, 2), Cells(r, "I"))
としましたが、これは
Set rng = Rows(r).Range("A1:B1,I1") とも書けます。
まず行を指定して、それに対して相対参照的にRange("A1:B1,I1")と続ければOKです。
このあたりはマクロ記録を一行単位でそのままコードにするという思考は勧められません。
マクロ記録ですべてができる、と考えないほうがよいと思います。
もちろん、あらゆるメソッドやプロパティを覚えている人はいないので、
適宜マクロ記録を参照しますが、部分的に参考にすることが一般的です。
この辺の見極めが、VBAに慣れるということです。
以上を纏めると下記のようになります。
Sub testその2()
Dim ws As Worksheet
Dim wb As Workbook
Dim r As Long
Dim rng As Range
Application.ScreenUpdating = False
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set wb = Workbooks("B.xlsx")
r = wb.Windows(1).ActiveCell.Row
With wb.Sheets(1)
Set rng = .Rows(r).Range("A1:B1,I1")
End With
rng.Copy
ws.Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.Goto ws.Range("A1") '元の位置に戻る
Application.ScreenUpdating = True
End Sub
以下が一番言いたいことなんですが、余りActiveCellに依拠しないほうがよいと思います。
シートから離れるときに、どのセルをアクティブにしていたかを意識している人は少ないと思います。
# 意識しすぎて”常にA1セルに戻すのを習慣にしている”という記事を見たことがあります。
ActiveCellを基準にしてデータを取得すると、思わぬものを取ってくることもあります。
そこは、意図的にユーザーに選択させたほうがよいでしょう。
その場合は、ApplicationのInputBoxメソッドを使って下さい。
https://www.moug.net/tech/exvba/0050045.html
が参考になるでしょう。
(なお、InputBox関数というのもあります。これとは別のものなので注意。)
Sub testその3()
Dim ws As Worksheet
Dim wb As Workbook
Dim r As Long
Dim rng As Range
Dim sourceRng As Range
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set wb = Workbooks("B.xlsx")
Application.Goto wb.Sheets("sheet1").Range("A1")
Set rng = Application.InputBox("転記したいデータがある行のセル(列は任意)を選択", Type:=8)
Set sourceRng = rng.EntireRow.Range("A1:B1,I1")
sourceRng.Copy
ws.Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.Goto ws.Range("A1")
End Sub