スキルアップ・問題解決なら、モーグにおまかせ！

Sub 作成()
 
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim bookname1 As Variant
 
bookname1 = ActiveWorkbook.Name
         
    'シートを変数へ格納
         
        Set Sh1 = Workbooks(bookname1).Worksheets("CS")　’転記元（このシートでVBA実行）
        Set Sh2 = ThisWorkbook.Sheets("ES")　’転記先（VBAが入っている）
 
    'フィルターでデータ抽出
     With Sh1.Range("A1")
        .AutoFilter 4, "〇"
        .AutoFilter 12, "14", xlOr, "29"
        .AutoFilter 28, ""
    End With
 
    'フィルター抽出結果を別シートへ転記
        Sh1.Range("E10:K" & Cells(Rows.Count, "E").End(xlUp).Row).Copy
        Sh2.Range("B2").PasteSpecial Paste:=xlPasteValues　
 
’（"B2"）以降にデータがある時は下に追加して転記したい。
  
        Sh1.Range("L10:L" & Cells(Rows.Count, "L").End(xlUp).Row).Copy
        Sh2.Range("J2").PasteSpecial Paste:=xlPasteValues
 
        Sh1.Range("M10:M" & Cells(Rows.Count, "M").End(xlUp).Row).Copy
        Sh2.Range("T2").PasteSpecial Paste:=xlPasteValues
 
         
 End Sub
 
ｓｈ1　から別ブックのｓｈ2へ抽出データを転記したいのですが
転記先のシートにデータがある場合は下に追加して転記をしたいです。
 

Sh2 の B 列の最終行を取得 = TagRow
・・・
Sh2.Range("B2") → Sh2.Range("B" & TagRow) へ変更するとかでしょうか。
 

既にご指摘のあった方法でも良いとは思いますが、
こういう書き方もあると思います。
    'フィルター抽出結果を別シートへ転記

    Sh1.Range("E10:K" & Cells(Rows.Count, "E").End(xlUp).Row).Copy

    Sh2.Range("B2").PasteSpecial Paste:=xlPasteValues

    Sh2.Cells(Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

回答ありがとうございます。
初心者なのですみません
下記エラーがでました
対応を教えていただけないでしょうか。
 
 
Sh2.Range("B" & TagRow)
Rsngeメソッドは失敗しました　Worksheetオブジェクト
 
Sh2.Cells(Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
アプリケーション定義またはオブジェクト定義のエラーです。
 
 
よろしくお願い致します。

・2点
1. TagRow に数値が正しく代入されていますでしょうか。
　※ F8 でステップ実行して、変数の上にマウスオーバーすると、代入の数値が確認できます。
  
2. (まさかとはおもいますが)Sh2.Range("B" & TagRow) だけ、行に記載していませんか？
Sh2.Range("B" & TagRow).PasteSpecial Paste:=xlPasteValues　です。
  
もう一度、変更された Code を貼り付けてください。
※ エラー発生の部分だけでは、正しく判断できません。

 
Sh1.Range("E10:K" & Cells(Rows.Count, "E").End(xlUp).Row).Copy ´ここまで実行できています
Sh2.Range("B" & TagRow).PasteSpecial Paste:=xlPasteValues　´ここでエラーメッセージ
　　　　TagRow　≒　Empty値と出ました。
 
よろしくお願いします。

TagRow に何も代入していないのであれば、
simple さんの、
Sh2.Cells(Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
で、いいのではないでしょうか。

書き方がまずかったですか。
この2行を

    Sh1.Range("E10:K" & Cells(Rows.Count, "E").End(xlUp).Row).Copy
    Sh2.Range("B2").PasteSpecial Paste:=xlPasteValues

    Sh1.Range("E10:K" & Cells(Rows.Count, "E").End(xlUp).Row).Copy
    Sh2.Cells(Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

値貼り付けのところはそれでOKのはずですが、まだエラーになりますか？
 
貼り付けのところでエラーになるということでしたので、コピー部分はノーマークでしたが、
今のコードでは、場合によっては意図したコピーができていないのではないですか？
気が付かなかったですね。
    Sh1.Range("E10:K" & Sh1.Cells(Rows.Count, "E").End(xlUp).Row).Copy
    Sh2.Cells(Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
ではないですか？
(1)
Cells(Rows.Count, "E").End(xlUp).Rowのほうには、シート名を付けないと、
・標準モジュールに書かれたコードなら、そのときアクティブなシートのE列最終行を意味します。
  もしSh2がアクティブだったりすると、所期する範囲がコピーされないことになります。
・シートモジュールに書かれたコードであれば、そのシートのE列最終行となります。
  もし、Sh2に書かれたコードだったりすると、所期する範囲がコピーされません。
(2)
なお、理屈から言えば、本来はRows.Countの頭にもシート名をつけたほうが良いわけですが、
どのシートでもRows.Countは同じ1048576ですので、慣用的に省略することが多いですね。

コメントありがとうございます。
 
 Sh1.Range("E10:K" & Cells(Rows.Count, "E").End(xlUp).Row).Copy
コピーまではできています。
 
Sh1.Range("E10:K" & Cells(Rows.Count, "E").End(xlUp).Row).Copy
Sh2.Range("B2").PasteSpecial Paste:=xlPasteValues
このコードではSheets("ES")のB2から問題なく転記できます。
 
 
 Set Sh1 = Workbooks(bookname1).Worksheets("CS")　’転記元（このシートでVBA実行）
 Set Sh2 = ThisWorkbook.Sheets("ES")　’転記先（VBAが入っている）
いろいろなコードを試してみたのですが転記ができいので
このコードに問題があるのででしょうか
 
 
Sh1とSh2　は別のフォルダありブック名も変更があるので固定のブック指定ができませんでした。
※シート名は固定です
2つのブックを開いた状態で　sh1　をアクティブにしてVBAは実施しています。
 
 
 

引用:
Sh1.Range("E10:K" & Cells(Rows.Count, "E").End(xlUp).Row).Copy
 コピーまではできています。

引用:
Set Sh1 = Workbooks(bookname1).Worksheets("CS")　’転記元（このシートでVBA実行）
 Set Sh2 = ThisWorkbook.Sheets("ES")　’転記先（VBAが入っている）
いろいろなコードを試してみたのですが転記ができいので
このコードに問題があるのででしょうか

よく見たら示した回答は試さず、放置なんですか？
何のために質問されているのですか？

simpleさん
提示いただいたコードは全て試しています。
結果を書いてなくてすみません。
 
    Sh1.Range("E10:K" & Cells(Rows.Count, "E").End(xlUp).Row).Copy
    Sh2.Cells(Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
コピーまではできて貼り付けできませんでした
 
　Sh2.Cells(Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
このコードもコピーまではできて貼り付けできませんでした
 
教えて頂いたコードを参考にいろいろ試していますが
貼り付けできないので
　ｓｈ2の指定の仕方がわるいのかなと思っています。
 
 
# 感じとしては、bookname1 = ActiveWorkbook.Nameが良くない気がします。
# そのときにアクティブなブックなので、ThisWorkbookがアクティブなら、
# 意図とは異なることになりますよ。
 
Bookの指定を考え直してまたご相談します。

Sub test()
    Dim Sh2 As Worksheet
    Set Sh2 = ThisWorkbook.Sheets("ES")
    Debug.Print Sh2.Cells(Rows.Count, "B").End(xlUp).Offset(1).Address(external:=True)
End Sub

念のためですが、コード中に
On Error Resume Next とかいったコードを入れていることはありませんね？

 
サブテスト実行しました。
'[☆E2022L.xls]ES'!$B$6
最終セルをしめしていました。
 
On Error Resume Nextはコードにいれてません。
 
下記コードで何故エラーになるのはやはりｓｈ1からｓｈ2への移行ができていないという事ですよね
Sh1.Range("E10:K" & Cells(Rows.Count, "E").End(xlUp).Row).Copy
Sh2.Cells(Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
 
ブックの指定の仕方をかんがえてみます。
Set Sh2 = ThisWorkbook.Sheets("ES")

同じようにコピー元の
Sh1.Range("E10:K" & Cells(Rows.Count, "E").End(xlUp).Row)についても
アドレスをしらべて教えてください。行数は何行ありますか？
 
転記先のブックは、xlsという古い形式のブックなので、
現在のものよりも行数が少なく、転記しようにも行数が足りないのではないですか？

Excel2003形式の場合の話はエラーメッセージが違うようですね。
 
手作業で同様作業を実行しても同じですか？
それをマクロ記録して比較してみてはどうですか？
ブックが壊れている可能性も無いことは無いですね。
他の新しいブックで試してみてください。
それでも同じ事象なら、致し方ないですね。（私にはというべきか）
私には想像ができません。ほかの回答者の回答を待ってください）

＞転記先のブックは、xlsという古い形式のブックなので、
＞現在のものよりも行数が少なく、転記しようにも行数が足りないのではないですか？
 
新しいブックに作成し直したら問題なくできました
初歩的な事ができてなくてすみません
長々とお付き合いいただき有難うございます
 
すごく勉強させていただきました
今後も参考にさせていただきます。
 
有難うございます。