[[20200415110419]]　『コピー貼リ付けについて』（カツ）　ページの最後に飛ぶ

『コピー貼リ付けについて』（カツ）

初心者です。宜しくお願いします。
下記でsheet1のオートフィルターのデータ結果の範囲2列目3行からZ列の最終行のまでをコピーしてSheet2のセルC24以降に貼り付けようとしましたが、2列目2行からコピーになります。
Range("Z3", Range("B3")でそうなっているのだと思いますがオートフィルターの結果で範囲2列目3行からZ列の最終行のまでをコピーするにはどうしたらよいでしょうか。

Sub test3()

Worksheets("Sheet1").Activate
Range("Z3", Range("B3").End(xlDown).Offset(0)).SpecialCells(xlCellTypeVisible).Copy Sheet2.Range("C24")

End Sub

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

■１
オートフィルタはどの範囲に設定されていますか？
わからなければ↓をそのまま実行して、イミディエイトに何と出力されたか教えてください。

    Sub 実験()
        Debug.Print Worksheets("Sheet1").AutoFilter.Range.Address(0, 0)
    End Sub

■２
ダメじゃないかもしれませんが

 ～　Sheet2.Range("C24")
     ↓
 ～　Worksheets("Sheet2").Range("C24")

のほうがよくないですかね。

（もこな２） 2020/04/15(水) 11:44

ありがとうございます。

■１　の教えて頂いた　Sub 実験()でイミディエイトにA1:H359と表示されました。
　このSheet1のデータは日々追加されていきます。オートフィルター後の結果の2列目3行からZ列の最終行を取りたいです。
　

■２は書き換えました。

宜しくお願いします。

（カツ） 2020/04/15(水) 12:08

すみません間違えました。
イミディエイトにA1:Z359と表示されました。
（カツ） 2020/04/15(水) 12:11

集合の共有を応用すればいいです。

Sub test3改()

    Dim rTo As Range, rFrom As Range
    Set rTo = Worksheets("Sheet2").Range("C24")
    Set rFrom = Worksheets("Sheet1").AutoFilter.Range
    Set rFrom = Intersect(rFrom, rFrom.Offset(2, 1), rFrom.Worksheet.Columns("A:Z"))
    '                       自身,3行目および2列目から,Z列まで
    If Not rform Is Nothing Then
        rFrom.Copy rTo
    End If
End Sub

（kazuo） 2020/04/15(水) 18:28

ありがとうございます。
嬉しいです。

If Not rform Is Nothing Thenのところでエラーがででオブジェクトが必要ですとなります。

（カツ） 2020/04/15(水) 20:30

変数名のタイプミスです。

（マナ） 2020/04/15(水) 20:52

Option Explicit の設定をしましょう!!
https://www.exvba.com/1917/

（マナ） 2020/04/15(水) 21:00

ごめんなさい。
If Not rfrom Is Nothing Then

（kazuo） 2020/04/15(水) 21:17

すいません動きましたありがとうございます。

オートフィルターで選択した結果の2列目3行目からZ列の最終行までを常にコピペしたいのですが
実際のセルB2からZ2がオートフィルター結果にあれば、B3以降をコピぺできるのですが、
セルB2からZ2がオートフィルターで隠れてしまえば、2列目2行目からZ列の最終行のコピペとなってしまいます。

（カツ） 2020/04/15(水) 22:55

＞2列目3行目からZ列の最終行
＞イミディエイトにA1:Z359と表示されました。
ということは、希望としては、B3～Z359のうち、【表示されている行】がコピーできれば良いという理解でよいですか？

 （項目行が1行目だとすると、【2行目～】になりそうですけど、本当に3行目なんでしょうか？）

（もこな２） 2020/04/16(木) 05:00

ありがとうございます。
説明が下手で申し訳ありませんでした。

（項目行が1行目だとすると、【2行目～】になりそうですけど、本当に3行目なんでしょうか？）

そうなんです。3行目です。
オートフィルターで選択した結果で見えているセルの2列目3行からZ列の最終行までをコピペしたいのです。
１行目（項目）で2行目はコピーしないデータなので3行目からコピべしたい。

＞2列目3行目からZ列の最終行

このSheet1のデータは日々追加されていきます。オートフィルター後の結果で2列目3行からZ列の最終行を取りたいです。

＞イミディエイトにA1:Z359と表示されました。
ということは、希望としては、B3～Z359のうち、【表示されている行】がコピーできれば良いという理解でよいですか？

データは日々追加されますので最終行のZ359のZの行数は変わりますがオートフィルターで選択した結果の【表示されている行】の３行目からコピーできれば助かります。

（以前の返信に記入させていただいたのですが
（■１　の教えて頂いた　Sub 実験()でイミディエイトにA1:H359と表示されました。このSheet1のデータは日々追加されていきます。オートフィルター後の結果の2列目3行からZ列の最終行を取りたいです。））

よろしくお願いします。

 　 
（カツ） 2020/04/16(木) 07:54

列は見えている見えていないは関係ないとして、

Sub test3改2()

    Dim i As Long
    Dim rTo As Range, rFrom As Range
    Set rTo = Worksheets("Sheet2").Range("C24")
    Set rFrom = Worksheets("Sheet1").AutoFilter.Range
    For i = 2 To rFrom.Rows.Count                 '項目行：見えている　1
        If rFrom(i, 1).Height <> 0 Then Exit For  'セル高さ0以外：見えている　2
    Next
    Set rFrom = Intersect(rFrom, rFrom.Offset(i, 1), rFrom.Worksheet.Columns("A:Z"))
    '                       自身,見えている3行目および範囲の2列目から,Z列まで
    If Not rFrom Is Nothing Then
        rFrom.Copy rTo
    End If
End Sub

（kazuo） 2020/04/16(木) 09:08

３行目～で正しいのですね・・
そして、問題は表示されている「２行目」が特定できないのでどこからと言えないと・・

一応最初に考えていたのか↓みたいな感じでした。

    Sub 作戦1()
        Dim eRNG As Range

        With Worksheets("Sheet1")
            Set eRNG = .AutoFilter.Range.Cells(.AutoFilter.Range.Cells.Count)

            .Range("B3", eRNG).Copy Worksheets("Sheet2").Range("C24")
        End With

    End Sub

でも↑だともともとの2～3行目が非表示だったときに、1、4行目をカットしたいのに4行目はコピーされちゃうってことですよね？

であれば、一旦作業シートに貼り付けて加工しちゃうのはどうでしょうか？

    Sub 作戦2()

        Worksheets.Add After:=Worksheets(Worksheets.Count)

        With Worksheets(Worksheets.Count)
            Worksheets("Sheet1").AutoFilter.Range.Copy .Range("A1")

            With .Range("A1").CurrentRegion
                Debug.Print .Address
                If .Rows.Count > 3 Then
                    .Offset(2, 1).Resize(.Rows.Count - 2, .Columns.Count - 1).Copy _
                    Worksheets("Sheet2").Range("C24")
                End If
            End With

            Application.DisplayAlerts = False
            .Delete
            Application.DisplayAlerts = True

        End With

    End Sub

（もこな２） 2020/04/16(木) 11:13

（もこな２）さん、（kazuo）さん、（マナ）さん

ご教授くださり本当にありがとうございました。
動かすことができました。感謝しています。

（カツ） 2020/04/16(木) 21:03

先日はありがとうございました。
教えて頂いたコピーペーストのコードに、値のみを張り付けようと調べると
Special Paste:=xlPasteValuesが値のみ貼り付けのようですがこのコードをどこに入れたらよいでしょうか。

 rFrom.Copyのところに入れてみたのですがエラーがでます。
ご教授ください。

Sub test3改2()

    Dim i As Long
    Dim rTo As Range, rFrom As Range
    Set rTo = Worksheets("Sheet2").Range("C24")
    Set rFrom = Worksheets("Sheet1").AutoFilter.Range
    For i = 2 To rFrom.Rows.Count                 '項目行：見えている　1
        If rFrom(i, 1).Height <> 0 Then Exit For  'セル高さ0以外：見えている　2
    Next
    Set rFrom = Intersect(rFrom, rFrom.Offset(i, 1), rFrom.Worksheet.Columns("A:Z"))
    '                       自身,見えている3行目および範囲の2列目から,Z列まで
    If Not rFrom Is Nothing Then
        rFrom.Copy rTo
    End If
End Sub

（カツ） 2020/04/20(月) 14:30

＞Special Paste:=xlPasteValuesが値のみ貼り付け
微妙に違います。

 Worksheets("Sheet2").Range("C24")   .PasteSpecial    Paste:=xlPasteValues
 ^^^^^^^^^^^^^^^↑^^^^^^^^^^^^^^^^    ^^^^^↑^^^^^    ^^^^^^^^^↑^^^^^^^^^
        対象のオブジェクト          形式を選択して貼付　    値のみ

なので、

 Worksheets("Sheet2").Range("C24").PasteSpecial Paste:=xlPasteValues

のように書くと

 (コピーして保持している内容を）Sheet2のC24セル（を起点）に値のみ貼付しなさい

という命令になってます。

また、オートフィルタで抽出している場合、抽出されていない行（非表示になっている行）は、コピー対象にならない仕様に変わっています。（少なくともエクセル2007以降であれば変わっています）

（もこな２） 2020/04/20(月) 15:07

ありがとうございます。
Worksheets("Sheet2").Range("C24").PasteSpecial Paste:=xlPasteValues
とするとエラーがでてしまいます。修正候補ステートメントの最後となるのです。
（カツ） 2020/04/20(月) 16:08

＞エラーがでてしまいます。修正候補ステートメントの最後となるのです。
現状のコードと【エラー発生個所】も示していただいたほうが、状況が掴みやすいですが↓が参考になったりしませんか？
http://officetanaka.net/excel/vba/error/compilation_error/error_2.htm

（もこな２） 2020/04/20(月) 17:48

すいません。ありがとうございます。
教えて頂いたHP見ましたが今度はコンパイルエラー　構文エラーとなります。

　　Set rTo = Worksheets("Sheet2").Range("C24").PasteSpecial Paste:=xlPasteValues　
　この部分が赤字になりコンパイルエラー　構文エラーとなりました。

　現状は↓です。

Sub test3改3()

    Dim i As Long
    Dim rTo As Range, rFrom As Range
    Set rTo = Worksheets("Sheet2").Range("C24").PasteSpecial Paste:=xlPasteValues'追加した値貼付

    Set rFrom = Worksheets("Sheet1").AutoFilter.Range
    For i = 2 To rFrom.Rows.Count                 '項目行：見えている　1
        If rFrom(i, 1).Height <> 0 Then Exit For  'セル高さ0以外：見えている　2
    Next
    Set rFrom = Intersect(rFrom, rFrom.Offset(i, 1), rFrom.Worksheet.Columns("A:Z"))
    '                       自身,見えている3行目および範囲の2列目から,Z列まで
    If Not rFrom Is Nothing Then
        rFrom.Copy rTo
    End If
End Sub

（カツ） 2020/04/20(月) 19:17

それぞれ意味があるので、適当に切り貼りしてもダメです。
↓をステップ実行して、ちょっと考えてみてください。

    Sub 実験()
        Dim 最終行 As Long
        Dim sh As Worksheet
        Dim i As Long, c As Long

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

        Set sh = Worksheets(1)

        With sh.AutoFilter.Range
            If .Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count < 3 Then
                MsgBox "抽出件数が少なすぎるため処理できません"
                Exit Sub
            End If

            '▼最終行を調べる
            最終行 = .Rows.Count

            '▼表示されている行のうち3行目を調べる
            For i = 1 To 最終行
                If .Rows(i).Hidden = False Then
                    c = c + 1
                End If

                If c = 3 Then
                    Exit For 'ここでループを抜けることにより｢i｣に目的の行が保持される
                End If
            Next i

            '▼表示されている行のうち3行目～最終行までをコピーして､値のみ指定したセルに貼付する
            .Rows(i & ":" & 最終行).Copy
            Worksheets("Sheet2").Range("C24").PasteSpecial Paste:=xlPasteValues
        End With
    End Sub

（もこな２） 2020/04/20(月) 22:15

（もこな２）さん
ありがとうございます。
説明もつけてくださり、このコードのわからないところを調べながら勉強させていただきました。
データの2列目から取りたかったので何とか.Columnsを追加してできました。
ご教授くださり感謝です。

（カツ） 2020/04/21(火) 16:18

＞データの2列目から取りたかった
そうでした。失念してました。

＞何とか.Columnsを追加してできました。
一応、こんな解決方法もあります。

    Sub 実験2()
        Dim 最終行 As Long
        Dim sh As Worksheet
        Dim i As Long, c As Long

        Stop
        Set sh = Worksheets(1)
        With sh.AutoFilter.Range
            If .Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count < 3 Then
                MsgBox "抽出件数が少なすぎるため処理できません"
                Exit Sub
            End If

            最終行 = .Rows.Count

            For i = 1 To 最終行
                If .Rows(i).Hidden = False Then
                    c = c + 1
                End If
                If c = 3 Then
                    Exit For
                End If
            Next i

            Application.Range(.Cells(i, 2), .Cells(.Cells.Count)).Copy  '←★この行を改造
            Worksheets("Sheet2").Range("C24").PasteSpecial Paste:=xlPasteValues
        End With
    End Sub

（もこな２） 2020/04/21(火) 18:04

お世話になっております。先日はありがとうございます
教えて頂いたコピー貼り付けの後にオートフィルター解除を追加したく最終行に　　
Worksheets("Sheet1").AutoFilterMode = False を追記しましたが
解除にならず困っています。またご教授頂ければ嬉しいです。
オートフィルターを解除して選択しないとWith sh.AutoFilter.Rangeでエラーとなります。

宜しくお願いします。

  Sub 実験()
        Dim 最終行 As Long
        Dim sh As Worksheet
        Dim i As Long, c As Long

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

        Set sh = Worksheets("Sheet1")

        With sh.AutoFilter.Range　➡ここでエラーとなる
            If .Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count < 3 Then
                MsgBox "抽出件数が少なすぎるため処理できません"
                Exit Sub
            End If

            '▼最終行を調べる
            最終行 = .Rows.Count

            '▼表示されている行のうち3行目を調べる
            For i = 1 To 最終行
                If .Rows(i).Hidden = False Then
                    c = c + 1
                End If

                If c = 3 Then
                    Exit For 'ここでループを抜けることにより｢i｣に目的の行が保持される
                End If
            Next i

            '▼表示されている行のうち3行目～最終行までをコピーして､値のみ指定したセルに貼付する
            .Rows(i & ":" & 最終行).Columns("B:Z)Copy
            Worksheets("Sheet2").Range("C24").PasteSpecial Paste:=xlPasteValues
        End With
　　　
　　Worksheets("Sheet1").AutoFilterMode = False ➡追加しましたオートフィルタ解除
    End Sub

（カツ） 2020/04/30(木) 23:08

コメント返信：

[ 一覧(最新更新順) ]

[[20200415110419]] 『コピー貼リ付けについて』（カツ） ページの最後に飛ぶ

[[20200415110419]]　『コピー貼リ付けについて』（カツ）　ページの最後に飛ぶ