Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10全般 : Microsoft 365)
転記先シートのデータの下へ転記
投稿日時: 22/08/04 17:54:47
投稿者: ryobon

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
 
sh1 から別ブックのsh2へ抽出データを転記したいのですが
転記先のシートにデータがある場合は下に追加して転記をしたいです。
 

回答
投稿日時: 22/08/04 18:12:05
投稿者: taitani

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

回答
投稿日時: 22/08/04 21:16:27
投稿者: simple

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

    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

参考にしてください。

投稿日時: 22/08/05 10:11:02
投稿者: ryobon

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

回答
投稿日時: 22/08/05 10:55:25
投稿者: taitani

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

投稿日時: 22/08/05 15:45:34
投稿者: ryobon

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

回答
投稿日時: 22/08/05 16:08:20
投稿者: taitani

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

回答
投稿日時: 22/08/05 20:32:25
投稿者: simple

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

    Sh1.Range("E10:K" & Cells(Rows.Count, "E").End(xlUp).Row).Copy
    Sh2.Range("B2").PasteSpecial Paste:=xlPasteValues
以下の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

回答
投稿日時: 22/08/08 10:33:07
投稿者: simple

値貼り付けのところはそれで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ですので、慣用的に省略することが多いですね。

投稿日時: 22/08/08 11:01:05
投稿者: ryobon

コメントありがとうございます。
 
 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は実施しています。
 
 
 

回答
投稿日時: 22/08/08 11:13:58
投稿者: simple

引用:
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が入っている)
いろいろなコードを試してみたのですが転記ができいので
このコードに問題があるのででしょうか
お困りの点が伝わりません。もう少し具体的に、
・想定はこうなるはずだが、
・実はこんなことになってしまう、
という説明をされたらどうですか?そうすれば回答があるはずです。
 
# 感じとしては、bookname1 = ActiveWorkbook.Nameが良くない気がします。
# そのときにアクティブなブックなので、ThisWorkbookがアクティブなら、
# 意図とは異なることになりますよ。

回答
投稿日時: 22/08/08 11:38:02
投稿者: simple

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

投稿日時: 22/08/08 12:17:21
投稿者: ryobon

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
このコードもコピーまではできて貼り付けできませんでした
 
教えて頂いたコードを参考にいろいろ試していますが
貼り付けできないので
 sh2の指定の仕方がわるいのかなと思っています。
 
 
# 感じとしては、bookname1 = ActiveWorkbook.Nameが良くない気がします。
# そのときにアクティブなブックなので、ThisWorkbookがアクティブなら、
# 意図とは異なることになりますよ。
 
Bookの指定を考え直してまたご相談します。

回答
投稿日時: 22/08/08 12:28:59
投稿者: simple

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

を実行して、イミディエイトウインドウに何が出力されるか、回答してください。
 
ESシートのB列のデータがある最終セルの次の行のアドレスを返すはずです。
こちらでは正常に実行されることを確認しています。
どこかに行き違いがあるのでしょう。

回答
投稿日時: 22/08/08 12:34:31
投稿者: simple

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

投稿日時: 22/08/08 13:27:13
投稿者: ryobon

 
サブテスト実行しました。
'[☆E2022L.xls]ES'!$B$6
最終セルをしめしていました。
 
On Error Resume Nextはコードにいれてません。
 
下記コードで何故エラーになるのはやはりsh1からsh2への移行ができていないという事ですよね
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")

回答
投稿日時: 22/08/08 14:14:06
投稿者: simple

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

回答
投稿日時: 22/08/08 14:53:00
投稿者: simple

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

投稿日時: 22/08/08 15:43:58
投稿者: ryobon

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