オートフィルタをし選択・貼付をマクロにしたいのですが、対象データ表示される行が毎回違うのでうまくいきません。

質問

いつもお世話になっております。

どなたかご教示いただければ助かります。

ファイル(1)のデータの中からA行が830となっているものを、ファイル(2)のページ1の一番下の行に付け足し
同じようにファイル(1)からA行が1000となっているものを、ファイル(2)のページ2の一番下に付け足す

という作業をマクロでしたいのですが、毎回830と1000がセルAの何行目に表示されるのかが異なっており、オートフィルタをかけた状態でマクロにするとマクロ作成時にたまたま表示されていた行数が指定されているので、別の日に違う行数をコピーしてしまい私が作成したマクロではうまくいきません。

どう変更すれば宜しいでしょうか？
どうぞ宜しくお願い致します。

Workbooks.Open Filename:="mm.xls"　　　　←上記文でファイル(1)

Sheets(DM).Select
Rows("1:1").Select
Selection.AutoFilter

Selection.AutoFilter Field:=1, Criteria1:="<>*850*", Operator:=xlAnd, _
Criteria2:="<>*1000*"
Range("A2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.EntireRow.Delete
ActiveSheet.Rows("1:1").Select
Selection.AutoFilter

Windows("xx.xls").Activate　　←ファイル(2)
Sheets("ll").Select　　　←ページ1　

ActiveSheet.Range("A1").Select
Selection.End(xlDown).Select

ActiveCell.Offset(1, 0).Activate

Windows("mm.xls").Activate

Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="1000"
Rows("3:3").Select
Selection.Copy

Windows("xx.xls").Activate
ActiveSheet.Paste
Application.CutCopyMode = False

Windows("xx.xls").Activate
Sheets("pp").Select　　←ページ2

ActiveSheet.Range("A1").Select
Selection.End(xlDown).Select

ActiveCell.Offset(1, 0).Activate

Windows("mm.xls").Activate
Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="850"
Rows("2:2").Select
Selection.Copy

Windows("xx.xls").Activate
ActiveSheet.Paste
Application.CutCopyMode = False

ActiveWorkbook.Save

Windows("mm.xls").Activate
ActiveWindow.Close

End Sub

回答No.5

hallo-2007 · ベストアンサー

列が非表示にされていたのですね。
今、マクロの記録で　数列の列を非表示、再表示を記録とったら
Sub Macro2()
Range("D:D,F:G,I:I").Select
Selection.EntireColumn.Hidden = True

Selection.EntireColumn.Hidden = False
End Sub
こんなコードが出来ました
・・・
Workbooks.Open Filename:="C:\ファイル1.xls"
Selection.EntireColumn.Hidden = False
'ファイル１の非表示を全て再表示する。
・・・
Windows("会社1.xls").Activate
Sheets("残高").Select
Selection.EntireColumn.Hidden = False
'会社１も全て再表示する。
・・・
Windows("会社1.xls").Activate
ActiveSheet.Paste
Range("D:D,F:G,I:I").Select'もとあった通りに非表示にする。
Selection.EntireColumn.Hidden = True
ActiveWorkbook.Save
・・・・
ではダメでしょうか。

回答No.7

hallo-2007

うまくいきましたか？VBAの参考までにコードを簡素化して応用が利くように
会社１.xlsに　設定　と云う名前のシート作成して
　　　A　　　B
１　パス　ファイル名
２　C:　　　ファイル１.xls
３　抽出文字　シート名
４　残高　　　1000
５　残高２　　　850
・・・と準備しておきます。
Sub Macro12()
'日付の設定
DMY = Range("b_date")
DM = Format(Range("b_date").Value, "yyyymmdd")
'残高に関してのマクロ
gyou = ThisWorkbook.Sheets("設定").Range("A65536").End(xlUp).Row
myfile = Sheets("設定").Range("B2").Value
mypath = Sheets("設定").Range("A2").Value
Workbooks.Open Filename:=mypath & "\" & myfile
Sheets(DM).Select
Cells.Select
Selection.EntireColumn.Hidden = False'非表示列を全部表示
Selection.AutoFilter

For i = 4 To gyou
Selection.AutoFilter Field:=1, Criteria1:=ThisWorkbook.Sheets("設定").Cells(i, 1).Value
Rows("2:20000").Copy
ThisWorkbook.Activate
Cells.Select
Selection.EntireColumn.Hidden = False
Sheets(Sheets("設定").Cells(i, 2).Value).Select
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Range("E:E,H:K,U:Y,AA:AE,AH:AN,AP:AP,AQ:AQ").EntireColumn.Hidden = True'指定した列を非表示にする
Application.CutCopyMode = False
Workbooks(myfile).Activate
Next

ThisWorkbook.Save
Workbooks(myfile).Close SaveChanges:=False'上書き保存せずに閉じる
End Sub
とFor～Nextで繰り返します。
自分のファイル名（会社1.xl）は　ThisWorkbookで指定します。（ファイル名を変更しても大丈夫）
VBAコード内にあった1000とか850もシートに移しておくと変更が加わっても
（ファイル１.xlsやファイルのパス、会社１のシート名も）
会社１の分けたいシートが増えても大丈夫です。
シートの値を変更することで対応できます。
ちょっとした応用ですが、将来踏まえて使いやすいものになります。
後でゆっくり勉強してみてください。

お礼

おはようございます！

ありがとうございます。このマクロで完璧に出来ました。
再表示後にもとの状態の非表示にする事がエクセルで出来る事自体知りませんでした・・・
何回も何回も、しかも応用の方法まで教えていただき、本当にありがとうございました。
毎回、このサイトには良い方が沢山いらっしゃって助かっています。
私も誰かのお役に立てればと思い回答を書き込んでいるのですが、こういう知識分野は到底無理で、早くもっとマクロが出来るようにならないとなと思っているところです。

応用は、今からシートを作って実際にRunさせながら把握していきます。
PCが苦手な私が上司に突然作成するよう言われここまできましたが、こうして新しい事を教えてもらえると、マクロもちょっと楽しみです。

hello-2007さん、本当にありがとうございました。
ポイントを付与するともう書き込めなくなってしまうので応用をRunさせた後の報告とお礼が出来ませんが、本当に本当にありがとうございました！
毎日寒く風邪も流行っておりますので、体調にはお気をつけ下さい。

回答No.6

hallo-2007

すみません。
少し割愛しすぎました。
全て再表示する部分は
Cells.Select
Selection.EntireColumn.Hidden = False
が必要でした。

回答No.4

hallo-2007

うまく伝わったようでよかったです。ただ
>データ元はコラムAからコラムBPまでが一行になっています。でもこの全てが私の作業に必要なわけではないので、縦何行かを非表示にしております。
が？です。
何行かが非表示？　列で例えばD列、G列が非表示？
ちなみに、提示のコードを整理しておきました。
Sub Macro1()
Workbooks.Open Filename:="D:\マイドキュメント\mm.xls"
'Workbooks.Open Filename:="mm.xls"
'mmファイルのDMシートのA列が1000の行をコピィ
Sheets("DM").Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="1000"
Rows("2:20000").Copy
'xxファイルのllシートの最後の行以下に貼り付け
Windows("xx.xls").Activate
Sheets("ll").Select
Range("A65536").End(xlUp).Offset(1, 0).Activate
ActiveSheet.Paste
'mmファイルのDMシートのA列が850の行をコピィ
Windows("mm.xls").Activate
Selection.AutoFilter Field:=1, Criteria1:="850"
Rows("2:20000").Copy
MsgBox Rows.Count

'xxファイルのppシートの最後の行以下に貼り付け
Windows("xx.xls").Activate
Sheets("pp").Select
Range("A65536").End(xlUp).Offset(1, 0).Activate
ActiveSheet.Paste
Application.CutCopyMode = False

ActiveWorkbook.Save
Windows("mm.xls").Activate
ActiveWindow.Close SaveChanges:=False
End Sub
最下位の行から上へ移動して最終の行を探してみましたが、途中に非表示の行があっても大丈夫になりませんか。

お礼

おつきあいいただきありがとうございます。
いただきましたマクロで動きに少し不具合が出ましたのでに修正を加え、下記にしてみましたところ、動きとしては完璧になりました。
ただ、やはり表示部分がうまくいきません。
具体的には
E H I J K U V W X Y AA AB　AC　AD　AE　AH　AI　AJ　AK　AL　AM　AN　AP　AQを非表示にしています。
そうすると、貼付け先には非表示部分はないものとされているようで
さももとからA B C D F G L・・・となっていたようにして貼付けられてしまうため、本来であればデータ元ではコラムBPまであるものがARまでしかないものと認識されています。
ですので、表示結果としてはデータ元コラムEが貼付け先コラムFに張付き、ずれています。
マクロは以下です。

Sub Macro11()

'日付の設定
DMY = Range("b_date")
DM = Format(Range("b_date").Value, "yyyymmdd")

'残高に関してのマクロ

Workbooks.Open Filename:="C:\ファイル1.xls"

Sheets(DM).Select
Rows("1:1").Select
Selection.AutoFilter

Selection.AutoFilter Field:=1, Criteria1:="1000"

Windows("会社1.xls").Activate
Sheets("残高").Select

ActiveSheet.Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Activate

Windows("ファイル1.xls").Activate
Rows("2:20000").Copy

Windows("会社1.xls").Activate
ActiveSheet.Paste

Application.CutCopyMode = False

Windows("会社1.xls").Activate
Sheets("残高2").Select

ActiveSheet.Range("A1").Select
Selection.End(xlDown).Select

ActiveCell.Offset(1, 0).Activate

Windows("ファイル1.xls").Activate
ActiveSheet.Rows("1:1").Select
Selection.AutoFilter

Sheets(DM).Select
Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="850"

Rows("2:20000").Copy

Windows("会社1.xls").Activate
ActiveSheet.Paste

ActiveWorkbook.Save

Windows("ファイル1.xls").Activate
ActiveWindow.Close
End Sub

すみません・・・宜しくお願い致します。

回答No.3

hallo-2007

こちらも説明がへたですみません。
>ファイル(1)のデータの中からA行が830となっているものを、ファイル(2)のページ1の一番下の行に付け足し
に限って説明します。
オートフィルターを行った後に
Rows("2:1000").Select
Selection.Copy
を実行してもオートフィルターで非表示の行はコピィの対象になりません。

こちらでsampl.xlsをいうファイルとBook1xlsを作成してひらいてあります。
sampl.xlsのA列に１から番号いれてあります。
Book1の標準モジュールに
Sub Macro1()
Windows("sampl.xls").Activate
Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="1"
Rows("2:1000").Select'←ここがキーです。
Selection.Copy
Windows("Book1.xls").Activate
ActiveSheet.Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
A列が１の1行だけがBook1の最後の行に貼り付けられます。
少し整理して、ファイルを上書きせずに閉じるを加えて
Sub Macro1()
Workbooks("sampl").Activate
Worksheets("Sheet1").Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="1"
Rows("2:1000").Copy
Workbooks("Book1").Activate
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
Workbooks("sampl").Close SaveChanges:=False
End Sub
も参考にしてみてください。

お礼

おはようございます。

大変失礼致しました。
Rows("2:1000").Select　　　の行がキーという認識が薄く、それをうまく活用せずにマクロがうまくいかないと言っておりました。
本当にすみません。
ご支持いただいた通りにしたところ、うまくいきました。ありがとうございました。

しかし、今までうまくいっていたものがこのマクロでは出来なくなってしまいまして改善方法がわかりません。もしおわかりでしたらご教示いただけないでしょうか？
データ元はコラムAからコラムBPまでが一行になっています。でもこの全てが私の作業に必要なわけではないので、縦何行かを非表示にしております。
貼付け先のファイルもデータ元と同じ縦行を非表示にしております。

この状態でマクロをRunさせると、非表示部分が貼付けられないようで、貼付け先の表示箇所が先日までとずれてしまいます。
非表示にしている貼付け先のコラムを予め削除しておく以外でいい方法はないでしょうか？

お忙しいところ申し訳ございません。
お力をお借りできれば幸いです。
どうぞ宜しくお願い致します。

回答No.2

hallo-2007

>オートフィルタをかけた状態でマクロにするとマクロ作成時にたまたま表示されていた行数が指定されているので、別の日に違う行数をコピーしてしまい私が作成したマクロではうまくいきません
問題は、マクロの記述で作成したコードでは常に３行目とかしかコピィしないので、空白がコピィされてしまうということなのですよね。
先に紹介した
Rows("2:1000").Select
とか2行目以降をたっぷりと選択してコピィしても、
オートフィルターで抽出すると、抽出された行のみコピィされますので
Selection.AutoFilter Field:=1, Criteria1:="850"
の条件の行が常にコピィされます。
質問を取り違えていたら補足して下さい。

お礼

ありがとうございます。

説明が下手ですみません。「空白がコピィ」とあるのですが、空白ではありません。。
毎日5000行ほどびっちりとデータはあります。なので空白ではないのですが
マクロの記述で作成したコードでは常に３行目とかしかコピィしないので、その日の3行目が”5900”の日もあれば”400”の日もあります。

なので5000行ほどある状態で

Selection.AutoFilter Field:=1, Criteria1:="0200624510"
ActiveSheet.Range("A2").Select
ActiveSheet.Range("A2:BQ2").Select
Selection.Copy

とすると
確かにコラムAが850の行がの一行だけ表示されるのですが
違うページに張付る際のマクロ、Selection.Copyで不具合が出てしまいます。
一度試してみていただけると幸いです。
質問している立場なのにご迷惑をおかけして申し訳ございません。
宜しくお願い致します。

回答No.1

hallo-2007

オートフィルター実行後は、抽出された行と下は空白ですよね。
Selection.AutoFilter Field:=1, Criteria1:="1000"
Rows("3:3").Select
Selection.Copy
を
Selection.AutoFilter Field:=1, Criteria1:="1000"
Rows("2:1000").Select
Selection.Copy
とたっぷりと範囲しては如何でしょうか。

お礼

返答が遅れ申し訳ございません。

抽出された行の下は空白なのですが

例えば、12月1日に取得したデータではコラムAが850となっているのが300行目で1000となっているのは500行目だったり、12月2日に取得すると850となっているのが400行目で1000となっているのが3行目だったりします。
私が作成したマクロはマクロの記録を使用していますので12月1日に作成したとすると、オートフィルタ後には（1行目は各タイトルなので）850が2行目に表示されているのでRows("2:2").Selectなのですが
12月2日だとオートフィルタ後には850は3行目に表示されているので（1行目はタイトル、2行目にコラムAが1000の行）、Rows("2:2").SelectではコラムAが1000の行を引っ張ってきてしまいます。

ここをなんとかしたいのですが・・・
いい方法があれば是非ご教示いただければ嬉しいです。

どうぞ宜しくお願い致します。