EXCEL VBA 任意のシートに貼りつけ

質問

御世話になります。おしえて下さい。
データPCのexcelデータからオートフィルタでデータを抽出して任意の列を
抽出するところまでは出来ているようですが、その先が付け焼刃ですので、
さっぱり解決策がみつけられません。
データをオートフィルタにて抽出→帳票ブックの任意のシートに張り付け
帳票のシート名はユーザフォームのリストボックスから代入してるつもりです。
宜しくお願い致します。

Option Explicit

Sub Macro3_2()

Dim myRL As Date
Dim MyRow As Long
Dim Window1 As Window
Dim buf As String

myRL = UserForm1.TextBox1
buf = UserForm1.ListBox1

Workbooks.Open Filename:= _
"\\WPCABC\Users\hoge\Documents\hogehoge\データ.xlsx"

ActiveSheet.ListObjects("テーブル_PCABC_からのクエリ") _
.Range.AutoFilter Field:=9, _
Criteria1:="=" & myRL
ActiveSheet.ListObjects("テーブル_PCABC_からのクエリ") _
.Range.AutoFilter Field:=12, _
Criteria1:=">=1"
MyRow = Worksheets("sheet1") _
.Range("A" & Rows.Count).End(xlUp).Row

Worksheets("sheet1").Activate
Range("B2:B" & MyRow).Select
Selection.Copy
------------------------------------------------------↓上手く出来ません
Workbooks("帳票.xlsm").Worksheets("buf") _
.Range("Y3" & MyRow) _
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Workbooks("帳票.xlsx").Worksheets("sheet1").Activate
Range("L2:L" & MyRow).Select
Selection.Copy
Workbooks("帳票.xlsm").Worksheets("buf") _
.Range("Z3" & MyRow) _
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Set Window1 = Application.Windows("クエリデータ.xlsm")
Window1.Activate

End Sub

回答No.1

keithin · ベストアンサー

オートフィルタで絞るところまでは問題無く出来てるって事で良いんですね。そこまでのマクロは流用します。
ヤリタイ事：
　ThisWorkbookのSheet1からオートフィルタで絞ったB列とL列をコピーする
　ユーザーフォームのListBox1で指定したシートのY列Z列に貼り付ける

Sub Macro3_2()

　Dim myRL As Date
　Dim MyRow As Long
　Dim Window1 As Window
　Dim buf As String

　myRL = UserForm1.TextBox1
　buf = UserForm1.ListBox1

　Workbooks.Open Filename:= _
　"\\WPCABC\Users\hoge\Documents\hogehoge\データ.xlsx"

　ActiveSheet.ListObjects("テーブル_PCABC_からのクエリ") _
　　.Range.AutoFilter Field:=9, _
　　Criteria1:="=" & myRL

　ActiveSheet.ListObjects("テーブル_PCABC_からのクエリ") _
　　.Range.AutoFilter Field:=12, _
　　Criteria1:=">=1"

　MyRow = Worksheets("sheet1") _
　.Range("A" & Rows.Count).End(xlUp).Row

　Worksheets("sheet1").Activate
’----------------
　range("B2:B" & myrow).copy worksheets("帳票.xlsm").worksheets(buf).range("Y3")
　range("L2:L" & myrow).copy worksheets("帳票.xlsm").worksheets(buf).range("Z3")
end sub

＃参考：
【間違い探し】
帳票.xlsmと帳票.xlsxが混在している
bufを""で囲ってはいけない
コピー元がフィルタで絞り込まれているので，貼り付け先セル範囲の行数はmyrow行ではない

お礼

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

あれこれ？？で弄り倒して、わけが分からなくなっていました。

本当にありがとうございました。<m(__)m>