
添付図を参照してください。
元データがある表(シート名:統計)へ(シート名:Sheet1)にあるオートフィルタで抽出したデータを統計 シートの最終行を判断して、Sheet1のA列とD列の該当のデータのみをコピーして
シートの最終行から貼り付けをするマクロを作成したいです。
最終行を判断するには、
Range(Selection, Selection.End(xlDown)).Select など記述すべきかと思いますが、
あくまでSheet1の抽出したデータ行は15行までではなくデータにより様々な行数を取得するようにしたいです。Range("A2", Range("A2").End(xlDown)).Select など?
すいませんが、ご教授頂きますようお願いいたします。

No.3ベストアンサー
- 回答日時:
No.1です。
>ちなみにオートフィルタでC列”教科”を算数、E列”ランク”をAを組み込む場合は・・・
コード内に"教科"と"ランク"を組み込んでしまうと汎用性がなくなると思いますので、
インプットボックスで"教科"と"ランク"を入力するようにしてみました。
Sub Sample2()
Dim lastRow As Long, wS As Worksheet, myRng As Range
Dim Kyouka As String, myRnk As String
Set wS = Worksheets("統計")
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set myRng = Range(.Cells(2, "A"), .Cells(lastRow, "E"))
Kyouka = Application.InputBox("フィルタを掛ける教科を入力")
myRnk = Application.InputBox("フィルタを掛けるランクを入力")
With .Range("A1")
.AutoFilter field:=3, Criteria1:=Kyouka
.AutoFilter field:=5, Criteria1:=myRnk
End With
If .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then
myRng.SpecialCells(xlCellTypeVisible).Copy wS.Cells(Rows.Count, "A").End(xlUp).Offset(1)
wS.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
End If
.AutoFilterMode = False
End With
End Sub
こんな感じではどうでしょうか?m(_ _)m
素晴らしい、この内容で奇麗に貼り付けれる事を確認いたしました。
ちなみにIf .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then~で
"Sheet1"シートのA行から"統計"シートのA行へ該当のデータをコピーしていますが、仮に"Sheet1"シートのA行から"統計"シートのB行へコピー、"Sheet1"シートのD行から"統計"シートのF行へと指定した行へコピーする事もできるのでしょうか?この場合は、記述がまた変わってくるのでしょうか?(追加になるかもしれませんが申し訳ございません、これで解消できると思います)
No.4
- 回答日時:
No.1・3です。
>仮に"Sheet1"シートのA行から"統計"シートのB行へコピー、"Sheet1"シートのD行から"統計"シートのF行へ・・・
「Sheet1」のA列を「統計Sheet」の最終行1行下のB列に、
「Sheet1」のD列を「統計Sheet」の最終行1行下のF列のにそれぞれコピー&ペーストする!という意味でしょうか?
そうであれば当然コードそのものが変わってきます。
Sub Sample3()
Dim j As Long, lastRow As Long, maxRow As Long, wS As Worksheet
Dim Kyouka As String, myRnk As String
Set wS = Worksheets("統計")
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Kyouka = Application.InputBox("フィルタを掛ける教科を入力")
myRnk = Application.InputBox("フィルタを掛けるランクを入力")
With .Range("A1")
.AutoFilter field:=3, Criteria1:=Kyouka
.AutoFilter field:=5, Criteria1:=myRnk
End With
If .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then
maxRow = wS.UsedRange.Rows.Count + 1
Range(.Cells(2, "A"), .Cells(lastRow, "A")).Copy wS.Cells(maxRow, "B")
Range(.Cells(2, "D"), .Cells(lastRow, "D")).Copy wS.Cells(maxRow, "F")
wS.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
End If
.AutoFilterMode = False
End With
End Sub
こんな感じになると思います。
ただ、「統計」Sheetの貼り付ける列を変えてしまうと、項目が異なる列に貼り付けることになるので
データとしては全く意味がないものになるような気がするのですが・・・m(_ _)m
早速のご回答ありがとうございます!その通りです! なるほど、こういうコードにすれば違った列にコピーができるのですね。 ”統計”シートにそもそも”Sheet1"シートと同じじゃないケースはどうするのかこれで解消できました。大変助かり感謝しております。ありがとうございました!
No.2
- 回答日時:
フィルタがかかっていれば、普通のコピーで可視行だけコピーできますよ。
こんな感じです。
Sub sample()
Dim FromRow As Long
Dim ToRow As Long
FromRow = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
ToRow = Worksheets("統計").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Sheet1").Range("A2:A" & FromRow).Copy _
Destination:=Worksheets("統計").Range("A" & ToRow)
Sheets("Sheet1").Range("D2:D" & FromRow).Copy _
Destination:=Worksheets("統計").Range("D" & ToRow)
End Sub
なるほど、こちらでも実現可能みたいです。他の方の補足にあるように、オートフィルタでC列”教科”を算数、E列”ランク”をAを組み込む場合は、また違ってくるのでしょうか?
No.1
- 回答日時:
こんばんは!
「統計」Sheetに貼りつけるのは、A列とD列だけで良いのですね?
一例です。標準モジュールにしてください。
Sub Sample1()
Dim lastRow As Long, wS As Worksheet
Set wS = Worksheets("統計")
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
If .FilterMode Then
Range(.Cells(2, "A"), .Cells(lastRow, "A")).SpecialCells(xlCellTypeVisible).Copy _
wS.Cells(Rows.Count, "A").End(xlUp).Offset(1)
Range(.Cells(2, "D"), .Cells(lastRow, "D")).SpecialCells(xlCellTypeVisible).Copy _
wS.Cells(Rows.Count, "D").End(xlUp).Offset(1)
Else
MsgBox "絞り込まれていません"
End If
End With
End Sub
※ とりあえずオートフィルタで絞り込まれている場合のみ
コピー&ペーストするようにしてみました。m(_ _)m
さすがです、これでできそうです。
ちなみにオートフィルタでC列”教科”を算数、E列”ランク”をAを組み込む場合は、どのような記述を追加すればよいのでしょうか? また違ってきますか?
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) マクロで最終行を取得してコピーしたい 3 2022/04/06 19:07
- Excel(エクセル) エクセルで最下行にデータを追加するVBA 6 2023/05/09 09:30
- Excel(エクセル) エクセルのマクロでコピー後の貼り付け先を毎回指定したところにしたい 5 2022/08/12 10:47
- Visual Basic(VBA) まとめシートから集計シートへA列のコードが一致したら1行コピーするマクロをネット上で見つけました。こ 1 2022/08/30 14:11
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- Visual Basic(VBA) 集計シートA列のコードと一致する右に並んだシート名(コード)の3行目から10行目をコピーして貼り付け 4 2022/08/18 15:24
- Excel(エクセル) VBAのoffsetの動き方について教えてください 3 2022/11/25 23:36
- Excel(エクセル) ②Excel 簡単にシートコピーしたら前日の残高と日付を変更させたい→マクロの記録でエラーが出ます 8 2022/07/16 20:40
- Excel(エクセル) 別のシートの最終行の値を参照するには 5 2022/12/15 13:18
- Visual Basic(VBA) 別シートのデータを参照して値を入れたい。 まとめデータシートのC列D列の値を商品一覧シートのコードが 7 2022/08/17 13:20
このQ&Aを見た人はこんなQ&Aも見ています
-
今年はじめたいことは?
今年はこれをはじめたい!ということを教えてください!
-
「これはヤバかったな」という遅刻エピソード
寝坊だったり、不測の事態だったり、いずれにしても遅刻の思い出はいつ思い出しても冷や汗をかいてしまいますよね。
-
モテ期を経験した方いらっしゃいますか?
一生に一度はモテ期があるといいますが、みなさんどうですか? いまがそう! という方も、「思い返せばこの頃だったなぁ」という方も、よかったら教えて下さい。
-
人生でいちばんスベッた瞬間
誰しも、笑いをとろうとして失敗した経験があると思います。
-
今から楽しみな予定はありますか?
いよいよ2025年が始まりました。皆さんには、今から楽しみにしている予定はありますか?
-
複数指定セルの可視セルのみを別シートに転記するVBAについて
Visual Basic(VBA)
-
オートフィルタで抽出したデータを別シートの最終行に追加させたい。
Excel(エクセル)
-
エクセルVBAで5行目からオートフィルタモードに設定したいたい
Excel(エクセル)
-
-
4
VBA オートフィルタで抽出したものを連続貼り付け
その他(Microsoft Office)
-
5
エクセルVBAでオートフィルター最上行を取得するには
Excel(エクセル)
-
6
エクセルで可視セルにのみ値貼り付けをする方法があったら教えて下さい やりたいこととしては フィルター
Excel(エクセル)
-
7
Excel VBAでオートフィルタで抽出したデータの一部だけ貼り付けるには(第2弾)
Excel(エクセル)
-
8
EXCELのVBA-フィルタ抽出後のセル選択方法
Visual Basic(VBA)
-
9
エクセルVBAで、値が入っている最終行の、右隣の値をコピーして、別のセルに貼り付けるコード
Excel(エクセル)
-
10
エクセルVBAでフィルタ抽出部分のみのコピー
Excel(エクセル)
-
11
ExcelのVBAを使ってタイトル行が2行ある場合の別シートへの抽出方法
Visual Basic(VBA)
-
12
数式による空白を無視して最終行を取得するマクロ
Excel(エクセル)
-
13
B列の最終行までA列をオートフィル
Visual Basic(VBA)
-
14
エクセル:マクロ「Application.CutCopyMode = False」って?
Excel(エクセル)
-
15
VBAで文字列を数値に変換したい
Excel(エクセル)
-
16
excelのマクロで該当処理できなければ飛ばして進むにはどうすればよいのでしょうか
Visual Basic(VBA)
-
17
【ExcelVBA】全シートのセルの数式を値に変換する事は可能でしょうか?
Visual Basic(VBA)
-
18
VBA オートフィルター繰り返し
Visual Basic(VBA)
-
19
別シートの最終行に貼り付けするマクロを教えてください。 シートYのE3からE15までをコピー シート
Excel(エクセル)
-
20
表にフィルターをかけ、絞ったデータ(可視化セルのみ)を一次元配列として変数に入れるという動作を書きた
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・一番好きなみそ汁の具材は?
- ・泣きながら食べたご飯の思い出
- ・「これはヤバかったな」という遅刻エピソード
- ・初めて自分の家と他人の家が違う、と意識した時
- ・いちばん失敗した人決定戦
- ・思い出すきっかけは 音楽?におい?景色?
- ・あなたなりのストレス発散方法を教えてください!
- ・もし10億円当たったら何に使いますか?
- ・何回やってもうまくいかないことは?
- ・今年はじめたいことは?
- ・あなたの人生で一番ピンチに陥った瞬間は?
- ・初めて見た映画を教えてください!
- ・今の日本に期待することはなんですか?
- ・集中するためにやっていること
- ・テレビやラジオに出たことがある人、いますか?
- ・【お題】斜め上を行くスキー場にありがちなこと
- ・人生でいちばんスベッた瞬間
- ・コーピングについて教えてください
- ・あなたの「プチ贅沢」はなんですか?
- ・コンビニでおにぎりを買うときのスタメンはどの具?
- ・おすすめの美術館・博物館、教えてください!
- ・【お題】大変な警告
- ・洋服何着持ってますか?
- ・みんなの【マイ・ベスト積読2024】を教えてください。
- ・「これいらなくない?」という慣習、教えてください
- ・今から楽しみな予定はありますか?
- ・AIツールの活用方法を教えて
- ・最強の防寒、あったか術を教えてください!
- ・歳とったな〜〜と思ったことは?
- ・モテ期を経験した方いらっしゃいますか?
- ・好きな人を振り向かせるためにしたこと
- ・スマホに会話を聞かれているな!?と思ったことありますか?
- ・それもChatGPT!?と驚いた使用方法を教えてください
- ・見学に行くとしたら【天国】と【地獄】どっち?
- ・これまでで一番「情けなかったとき」はいつですか?
- ・この人頭いいなと思ったエピソード
- ・あなたの「必」の書き順を教えてください
- ・14歳の自分に衝撃の事実を告げてください
- ・人生最悪の忘れ物
- ・あなたの習慣について教えてください!!
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
マクロで最終行を取得してコピ...
-
Excel VBAでオートフィルタで抽...
-
【VBA】条件に一致しない行を削...
-
数値に見えるものはすべて数値...
-
エクセルのデータがない行には...
-
【VBA】条件に一致しない行を削...
-
Access2003レポート:最終ペー...
-
VBAで入力の結果を他のセルに反...
-
エクセルで空白行を削除する ...
-
VBA 複数列コンボボックス 値の...
-
エクセルマクロでの行削除の方...
-
マクロにて指定の文字間の文字...
-
Excel97 指定した行だけマク...
-
オートフィルターの複数条件検...
-
EXCEL VBAでA列にある空白行よ...
-
エクセルのマクロについて質問...
-
Excel マクロ 検索結果を別シ...
-
vbaエクセルマクロについて she...
-
Excelで、あるセルの値に応じて...
-
VB.net
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
マクロで最終行を取得してコピ...
-
【VBA】条件に一致しない行を削...
-
数値に見えるものはすべて数値...
-
エクセルで空白行を削除する ...
-
Excel VBAでオートフィルタで抽...
-
VB.net
-
エクセルのデータがない行には...
-
列から特定の文字列検索→該当以...
-
【VBA】条件に一致しない行を削...
-
Excel マクロ 検索結果を別シ...
-
マクロにて指定の文字間の文字...
-
エクセルで階層図を作る方法
-
EXCEL VBAでA列にある空白行よ...
-
VBAで入力の結果を他のセルに反...
-
各個体に対する平均値の自動計...
-
vbaエクセルマクロについて she...
-
テキストファイル読み込みにお...
-
Excel97 指定した行だけマク...
-
コマンドボタンでの自動計算マ...
-
Access2003レポート:最終ペー...
おすすめ情報
たびたびすいません、該当のデータをコピーした後、コピーした行まで罫線を引いておく
事もしたいのですができますでしょうか?(B、C、E行も)