• ベストアンサー
  • すぐに回答を!

全てのシートに同じ条件で処理をし保存するマクロ

いつも識者の皆様にはお世話になっております。 Excel VBAのことで質問させてください。 ファイル名やその中のシートの数がばらばらで、データの型が同じファイルが毎日生成されます。 下記の流れでVBAで処理をしたいと思っています。 1.ファイルを開くダイアログを出し、ブックを指定する。 2.開いたブックにある全てのシートに対し、A列が"aaa"以外の行を削除する。 3.同じディレクトリに、ファイル名の前頭に"ccc"と付けて保存する。 しかし、それぞれのシートにはデータが20000-30000行あり、上記方法だとScreenUpdatingをfalseにしても時間がかかるという記述を見つけたため、 1.ファイルを開くダイアログを出し、ブックを指定する。 2.開いたブックにある全てのシートに対し、A列が「"aaa"と等しい」の条件でフィルタをかけ、そのデータを別の新しいブックに貼り付ける(シート名も同じにする) 3.ダイアログで開いたブックと同じディレクトリに、ファイル名の前頭に"bbb"と付けて保存する。 このような手順でやろうと思っていますが、ダイアログを出すところまではなんとかたどり着けたんですが、その後がまったくわかりません。 ご参考にならないとは思いますが、書きかけ(というかダイアログを出してworkbookを追加するだけ)のコードを添付いたします。 Sub test() Dim OpenFileName As String OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?") If OpenFileName <> "False" Then Workbooks.Open OpenFileName Else MsgBox "キャンセルされました" End If Workbooks.Add End Sub 識者の皆様、どうかご回答よろしくお願いいたします。

共感・応援の気持ちを伝えよう!

  • 回答数1
  • 閲覧数210
  • ありがとう数1

質問者が選んだベストアンサー

  • ベストアンサー
  • 回答No.1
  • keithin
  • ベストアンサー率66% (5278/7939)

こんなカンジ: sub macro1()  dim myPath as string  dim myFile as string  dim s as worksheet  myfile = application.getopenfilename()  if myfile = "False" then   msgbox "cancel"   exit sub  end if  application.screenupdating = false  application.calculation = xlcalculationmanual  workbooks.open myfile  mypath = activeworkbook.path & "\"  myfile = "ccc" & activeworkbook.name  for each s in activeworkbook.worksheets   s.autofiltermode = false   s.range("A:A").autofilter field:=1, criteria1:="<>aaa"   s.autofilter.range.offset(1).entirerow.delete shift:=xlshiftup   s.autofiltermode = false  next  activeworkbook.saveas filename:=mypath & myfile  activeworkbook.close false  application.calculation = xlcalculationautomatic  application.screenupdating = true  msgbox "DONE" end sub

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ありがとうございます! できました!

関連するQ&A

  • エクセル マクロでシートをデスクトップに保存する

    ファイルにある複数のシートの中から、Bシートだけを抜き出してデスクトップに保存するマクロがわかりません。 他のサイトで以下のVBAがあったので参考にしたのですが Cドライブのマイドキュメントに保存されます。 デスクトップに直接保存したいです。 Sub シートコピーR() ' 1.保存したいシートをシートコピーする。 Sheets("Sheet1").Copy ' 2.アクティブシートのセル全体に対して、コピー&値のみ貼り付けをする。 ActiveSheet.Cells.Copy ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues 'ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False ' 3.アクティブブックを保存する。 ActiveWorkbook.SaveAs FileName:="C:\ファイル名.xls" End Sub 教えてください。

  • ユーザーフォームがシートの裏に隠れてしまう

    ブックを開いた時に、表示されるユーザーフォームが作業シートの裏に隠れて、作業が思うようにできません。なんとかシートの前面に表示させたいです。EXCEL365solo,WINDOWS10使用の超初心者です。ご指導よろしくお願いします。 Private Sub CommandButton96_Click() Dim OpenFileName As String Unload Me ChDir Application.ThisWorkbook.Path & "\2年集計" OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xlsm") G給与入力.Show vbModeless If OpenFileName <> "False" Then Workbooks.Open OpenFileName Else MsgBox "キャンセルされました" End If End Sub

  • エクセルのシートのコピーについて

    シートのコピーをVBAで行いたいのですが、エラーになってしまいます。 間違っている箇所が分からないのでご教授お願いします。 貼り付けというブックにマクロが組まれています。 ”データ”のブックにあるシート名が”貼り付けのブックのリスト”のシートに記載されています。 リストのシートに記載されているシートを貼り付けのブックにコピーしたいです。 よろしくお願いします。 Sub シートコピー() 行数 = 2 Do Until IsEmpty(Cells(行数, 3).Value) コピー元 = Workbooks("貼り付け.xls").Worksheet("リスト").Cells(行数, 3) Workbooks("データ.xls").Worksheet(コピー元).Copy After:=Workbooks("貼り付け.xls").Sheets(Workbooks("貼り付け.xls").Sheets.Count) 行数 = 行数 + 1 Loop End Sub

  • 【マクロ】指定したファイルを開いてマクロを実行

    マクロ初心者です。よろしくお願いします。 <質問> コマンドボタンをクリックしたら、任意のエクセルファイルを指定して開き、その開いたファイル(白紙状態のファイル)にマクロを実行させる方法を探してます。 <作成マクロ> Private Sub CommandButton1_Click() Dim OpenFileName As String OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls") If OpenFileName <> "False" Then Workbooks.Open OpenFileName End If Workbooks(Dir(OpenFileName)).Activate ActiveCell.FormulaR1C1 = "テスト" Range("A1").Select Selection.Copy Range("B1").Select ActiveSheet.Paste End Sub <マクロ説明> --コマンドボタンをクリックして指定したエクセルファイルを開く-- Private Sub CommandButton1_Click() Dim OpenFileName As String OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls") If OpenFileName <> "False" Then Workbooks.Open OpenFileName End If Workbooks(Dir(OpenFileName)).Activate --開いたエクセルファイル(白紙状態)のセルA1に「テスト」を入力した後、コピーしセルB2に貼り付ける--   ActiveCell.FormulaR1C1 = "テスト" Range("A1").Select Selection.Copy Range("B1").Select ActiveSheet.Paste End Sub コマンドボタンをクリック ↓ 任意のエクセルファイルを指定して開く ↓ 開いたファイル(白紙状態のファイル)のセルA1に「テスト」と書き込み セルA1の「テスト」をコピーしセルB1に貼り付ける このマクロを実行させるにはどこを改善すれば良いでしょうか? ご助言いただけると助かります。 よろしくお願い致します。

  • 【マクロ】指定したファイルを開いてマクロを実行

    マクロ初心者です。よろしくお願いします。 <質問> コマンドボタンをクリックしたら、任意のエクセルファイルを指定して開き、その開いたファイル(白紙状態のファイル)にマクロを実行させる方法を探してます。 <作成マクロ> Private Sub CommandButton1_Click() Dim OpenFileName As String OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls") If OpenFileName <> "False" Then Workbooks.Open OpenFileName End If Workbooks(Dir(OpenFileName)).Activate ActiveCell.FormulaR1C1 = "テスト" Range("A1").Select Selection.Copy Range("B1").Select ActiveSheet.Paste End Sub <マクロ説明> --コマンドボタンをクリックして指定したエクセルファイルを開く-- Private Sub CommandButton1_Click() Dim OpenFileName As String OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls") If OpenFileName <> "False" Then Workbooks.Open OpenFileName End If Workbooks(Dir(OpenFileName)).Activate --開いたエクセルファイル(白紙状態)のセルA1に「テスト」を入力した後、コピーしセルB2に貼り付ける--   ActiveCell.FormulaR1C1 = "テスト" Range("A1").Select Selection.Copy Range("B1").Select ActiveSheet.Paste End Sub コマンドボタンをクリック ↓ 任意のエクセルファイルを指定して開く ↓ 開いたファイル(白紙状態のファイル)のセルA1に「テスト」と書き込み セルA1の「テスト」をコピーしセルB1に貼り付ける このマクロを実行させるにはどこを改善すれば良いでしょうか? ご助言いただけると助かります。 よろしくお願い致します。

  • 【VBA】ファイルを開く→シートをコピー→保存

    VBAを使って、複数ファイルを一気に編集したいです。 あるフォルダ内に、複数のエクセルブックと VBAを登録したブックが入っています。 VBAの内容としては、 (1)フォルダ内のエクセルファイルをすべて開く (2)各ファイル1ページ目のシートを複製(コピー)する (3)上書き保存して閉じる (4)VBAを登録したブックを閉じる です。 下記のように書いてみたのですが、まったく動かないので どこが間違っているかのアドバイスをいただければと思います。 ----------------------------------------------------- Sub test() Dim Myfile, Filepath As String Filepath = ThisWorkbook.Path 'フォルダ名取得 Myfile = Dir(Filepath & "\") 'フォルダ内のファイル名取得 Do While Myfile <> "" Workbooks.Open Filename:=Filepath & "\" & Myfile Workbooks(Myfile).Activate Sheets(1).Select Sheets(1).Copy after:=Sheets(1) Workbooks(Myfile).Close SaveChanges:=True Myfile = Dir() Loop ThisWorkbook.Close SaveChanges:=True End Sub ----------------------------------------------------- よろしくお願いいたします。

  • エクセル2007のマクロについて

    実践で学ぶ Office Excel 2007 VBAというマクロの学習サイトで Sub Macro実践1() 'ブック シート セルアドレスを指定すればブック シートをアクティブにする必要はない             Workbooks("転記.xlsx").Worksheets("転記シート1").Range("A1").Value = _               Workbooks("データ.xlsx").Worksheets("データ1").Range("A1").Value                 End Sub         と入力すると「インデックスが有効範囲にありません」となってしまいます。なにか間違っているのでしょうか?

  • すべてのシートに同じ処理をするにはこれでいい?

    フォルダ内にあるすべてのブックのすべてのシートに同じ処理をするマクロを書いたのですが思った動きをしてくれませんでした。 ちなみにやりたい事は!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!で囲まれたところだけ変えれば、シート数がバラバラな複数のブック内のすべてのシートで同じ処理が行われるようになる事です。 今回は複数のブックのA列を選択してコンマで区切るようにしています。 いろんなとこからコピペでつなぎ合わせたんですがどこがわるいんだろう?コンパイルはできてしまうのでどこを直せばいいのやら自力で見つけられません。お助けください。 環境はExcel2007 Windows7です。 Sub Allfile() Dim PATH As String Dim KTS As String PATH = Application.InputBox("編集したいファイルがあるフォルダのパスを入力。", "入力", Type:=2) KTS= Application.InputBox("編集したいファイルの拡張子を入力(ドットもいれる)。", "入力", Type:=2) Application.ScreenUpdating = False '画面の更新をしないようにして処理速度up Dim fileNmCol As Collection 'ファイル名格納コレクション Dim tempFileNm As Variant Dim fullPath As String Set fileNmCol = New Collection tempFileNm = Dir(PATH + "*KTS", vbNormal) 'Dirにより、ファイル名を取得フォルダ配下にあるファイル名を順次fileNmに格納する。 Do While tempFileNm <> "" 'ファイル名をfileNmColに追加する fileNmCol.Add (tempFileNm) tempFileNm = Dir() Loop For Each tempFileNm In fileNmCol 'ファイルの数だけ繰り返し ↓以下ブックごとの処理 fullPath = PATH + tempFileNm 'ファイルのフルパスを設定指定して、Excelブックを開く Workbooks.Open fullPath Dim Ws As Worksheet  'ワークシートの変数を用意   For Each Ws In Worksheets 'シートの数だけ繰り返し ↓以下シートごとに対する処理 Ws.Activate 'Ws.Activate」がないと、はじめのシートのみの実行となります。 '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!   Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ :=Array(1, 1), TrailingMinusNumbers:=True 'A1行を選択してコンマ区切りにする '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Next Ws Next Application.ScreenUpdating = True End Sub

  • Excelマクロで同じブックにCSVを読み込むには

    Excelの指定したシートにCSVファイルを読み込ませたいのですが 以下のVBAマクロを実行すると新しいブックが起動して 新しいブックの方にCSVファイルが読み込まれてしまうのですが これをVBAマクロを実行しているブックの指定のシート(例えばSheet3など)に 読み込ませたいのですがどのように記述すればよいのでしょうか。 よろしくお願いします(Excel2010) Sub Macro1()  ChDir "C:\test"  Workbooks.Open Filename:= "test1.csv" End Sub

  • Excelマクロ(VBA)のブックとシートのコピーについて

    初めまして、宜しければVBAのブックやシートのコピー(操作)についてご教授お願いいたします。 Windows XP x64 OFFICE2003 を使用しております。 D:\Book1.elxのsheet1のシートをD:\test\Book2.elxのsheet1のシートに コピーする方法が恥ずかしながら理解できておりません。 以下が行いたい事です。 Sub ボタン1_Click() 'text1ブックを開く 'Workbooks.Open "D:\micro\test1.xls" 'ブック間のシートをコピー Workbooks("test2.xls").Worksheets("シート2").Copy _ After:=Workbooks("test1.xls").Worksheets("Sheet2") End Sub VBのファイル操作とは違い、どのように行えば良いのか検索しても同じような部分サンプルのようなものしか無く、理解できておりません。 参考でも結構ですのでご教授いただけませんでしょうか? よろしくお願いいたします。