[[20200831142857]]　『オートフィルタ後のコピペ』（じょあ）　ページの最後に飛ぶ

『オートフィルタ後のコピペ』（じょあ）

5枚目のDataをオートフィルタでAB2セルのデータで絞り、1枚目のシートの既存データの下に張り付けたく以下のように記載したのですが、コピー領域と貼り付け領域が異なるというエラーが出てしまいます。
貼り付けの記載をどのように修正すればよいか教えて頂けないでしょうか。

Sub シート5のデータをシート1の下に張り付け()

        Dim LrowP As Integer
With Sheets(5)
    LrowP = .Cells(Rows.Count, "A").End(xlUp).Row

        Dim PRRM As String
        PRRM = .Cells(2, "AB")
        .Range("$A$1:$AB$" & LrowP).AutoFilter Field:=28, Criteria1:=PRRM

    Sheets(5).Range("A1").CurrentRegion.Offset(1).Resize(.Rows.Count - 1).Copy
    Sheets(1).Cells(Sheets(1).Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteAll
    End With
End Sub

＜使用 Excel：Office365、使用 OS：Windows10 ＞

ちゃんと動きましたよ？セル結合とかしてませんか？
（A列下端が縦に結合されているせいで、最下端が空欄になっており、.End(xlUp)だと1行ずれる、とか）

問題部分ではないですが、気になる点としては、AB2セルにキーワードが入力されているようですが、この列はオートフィルタに入っているという事。まぁ、必ず自分自身1件以上はヒットしますけど、これは意図したものなのでしょうか？

あと、動くけど無意味に思うのが、LrowP で行末を得ているのに、コピーするのは (.Rows.Count - 1) と、1行目以外最下端まで全部対象にしていること。 Resize(LrowP - 1).Copy で良いのでは？
（???） 2020/08/31(月) 14:54

???様
ご確認頂きありがとうございました。
私も前回は動いていたのに今回はエラーがでたという状況で原因がわからず質問させていただきました。
VBA以外の原因がありそうですね。もう少し探ってみます。

セル結合などはしていないです。
オートフィルタは意図したものになります。
行末のご指摘もありがとうございました。まだ勉強中で何度か書き直しているので不要な記載が残ってしまっていました。
（じょあ） 2020/08/31(月) 16:15

横からですが、たぶん

 ～.Resize(.Rows.Count - 1).Copy
    ↓
 ～.Resize(Sheets(5).Rows.Count - 1).Copy
    ↓
 ～.Resize(1048576 - 1).Copy
    ↓
 ～.Resize(1048575).Copy

なので「Sheets(1)」の３行目以降に貼り付けようとすると、そのエラーが出るとおもいます。

本当は「オートフィルタで抽出されている範囲を【項目行を除いて】コピーしたいってことだったりしませんか？
そうであれば、単純にオートフィルタが設定されている範囲を１行ずらしてコピーしちゃえばよいとおもいます。

    Sub 整理()
        Dim LrowP As Integer

        Stop 'ブレークポイントの代わり

        With Sheets(5)

            '▼A列最終行を取得
            LrowP = .Cells(.Rows.Count, "A").End(xlUp).Row

            '▼オートフィルタを一旦解除
            .AutoFilterMode = False

            '▼オートフィルタを設定＆抽出
            .Range("A1:AB" & LrowP).AutoFilter Field:=28, Criteria1:=.Range("AB2").Value

            '▼オートフィルタが設定されている範囲を１行ずらして（抽出されているデータを）コピーして
            '  Sheets(1)のA列最終行の下に貼付
            .AutoFilter.Range.Offset(1).Copy Sheets(1).Cells(.Rows.Count, "A").End(xlUp).Offset(1)
        End With
    End Sub

（もこな２） 2020/08/31(月) 19:58

追加で。

 Sheets(5).Range("A1").CurrentRegion

↑で取得できる範囲でいいなら↓でもよくないです？

 Sheets(5).Range("A1").Range("A1").AutoFilter

（もこな２） 2020/09/01(火) 04:51

もこな2様
ご助言および解説頂きありがとうございました。
仰る通りオートフィルタ後の項目行を除いたコピーが目的だったのですが、教えて頂いた方法をしらなかったので勉強になりました。
頂いたコードと比べると、私のコードでは最終行を取る箇所でドットが抜けていたので、そのあたりも原因かもしれません。
頂きましたコードで動かしたところエラー無く動いております。
夜中(早朝?)までご検討いただきありがとうございます。
（じょあ） 2020/09/01(火) 10:00

＞私のコードでは最終行を取る箇所でドットが抜けていたので、そのあたりも原因かもしれません。

いえ、そうじゃなくて、繰り返しになりますが、
【コピーする範囲】が１～1048575行目になっているので
例えば、【貼付先】が3行目だと、1048575行目があふれちゃってエラーになりませんか？ということです。
（貼付先が2行目までなら、ギリギリセーフ）

ポイントとして、

    With Sheets(5).Range("A1").CurrentRegion
        .Offset(1).Resize(.Rows.Count - 1).Copy
    End With
    Sheets(1).Cells(Sheets(1).Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteAll

のようであれば問題ないので、注目すべきは「Resize」するときに使っている「.Rows.Count」が何の行数を返しているか考えることだとおもいます。
今回は、シート全体の行数としてしまったために、膨大な行をコピー対象にしてしまい、貼付時にあふれちゃったというのが真相じゃないでしょうか？

ちなみに、???さんが指摘されているように、LrowPを使うのもアリですね。

（もこな２） 2020/09/01(火) 10:55

もこな2様
改めて理解致しました。
詳細にご説明頂きありがとうございました。

（じょあ） 2020/09/01(火) 14:54

コメント返信：

[ 一覧(最新更新順) ]

[[20200831142857]] 『オートフィルタ後のコピペ』（じょあ） ページの最後に飛ぶ

[[20200831142857]]　『オートフィルタ後のコピペ』（じょあ）　ページの最後に飛ぶ