Excel - 新しいブックを作成してデータをコピーするマクロ

問題

列のセルの一部の内容に基づいて行をコピーするマクロを探しています。 "arc.xlsx"という名前のExcelスプレッドシートがあります。そこから、特定の条件が満たされたときに、他のいくつかの新しいExcelファイルにデータをコピーしたいと思います。 Excelファイルの格納場所はC：\ Documents and Settings \ xxxx \ Desktop \ Companyです。 Excelの初心者です。

下記はarc.xlsxのサンプルです。

 GP BR CUST_NO CUST_NAME day mo year I1 01 999999 SMITH 00 08 09 I1 ab 999999 SMITH 04 08 09 I1 cd 999999 SMITH 04 10 09 I1 01 999999 SMITH 04 01 10 I1 02 999999 SMITH 27 02 10 I1 01 999999 SMITH 27 02 10 I1 cd 999999 SMITH 02 03 10 I1 cd 999999 SMITH 04 03 10 I1 cd 999999 SMITH 30 07 09 I1 ab 999999 SMITH 30 07 09 I1 02 999999 SMITH 30 07 09 

• このマクロで、列Bに「ab」が含まれる行（タイトルBR）をコピーして、同じ場所のフォルダー内にab.xlsxという名前で新しいExcelファイルに保存します。
• また、「cd」、「01」、「02」についても、cd.xlsx、01.xlsxなどの名前のファイルにデータを保存します。

溶液

1.あなたのワークブックをバックアップする

2.ワークブックを開く

3. Alt + F11キー（AltキーとF11キーの両方を同時に）を押します。 このオープンVBE

4. VBEのメニューから、挿入をクリックし、それをクリックしてモジュールを選択します。 これは空白のモジュールを開きます

5.コードを選択し（指示の後に表示されます）、Ctrl + Cキー（両方のキーを同時に）を押して、指示の後に記載されているコードをコピーします。

6.モジュールをクリックしてCtrlキーを押しながらVキーを押して、新しく追加したモジュールにコードを貼り付けます（手順4を参照）。

7.貼り付けたコードに赤い線がないことを確認します。

8. F5キーを押してマクロを実行します。

9通常Excelがファイルを保存するデフォルトの場所にある文書を確認します。

ここにコードがあります

 Sub details（）Stringとして薄暗いthisWBとして薄暗いthisWBとして薄暗いnewWB = ActiveWorkbook.Name次のシート（ "tempsheet"）にエラーが発生しましたエラー時に削除GoTo 0 Sheets.Add ActiveSheet.Name = "tempsheet" Sheets（ "Sheet1"）。 ActiveSheet.AutoFilterMode If Cellsを選択します。エラー時に選択次へActiveSheet.ShowAllDataエラー時に0移動先列（ "B：B"）を選択します。Selection.Copy Sheets（ "tempsheet"）を選択します。範囲（ "A1"）を選択します。 ActiveSheet.Paste Application.CutCopyMode = False（Cells（1、1）= ""）の場合lastrow = Cells（1、1）。End（xlDown）.Rowrow Rows.Countの場合範囲の場合（A1：A） ＆lastrow - 1）。選択を選択します。削除シフト：= xl列の場合は終了（ "A：A"）。列の選択（ "A：A"）。AdvancedFilterアクション：= xlFilterCopy、= CopyToRange：= Range（ " B1 "）、一意：= True列（" A：A "）。セルを削除します。Selection.Sortを選択します。_ Key1：= Range（" A2 "）、Order1：= xlAscending、_ Header：= xlYes、OrderCustom：= 1 、_ MatchCase：= False、向き：= xlTopToBottom、_ DataOption1：= xlSortNormal lMaxSupp = Cells（Rows.Count、1）.End（xlUp）.Sow For s uppno = 2 lMaxSupp Windows（thisWB）にアクセスします。supName = Sheets（ "tempsheet"）を有効にします。Range（ "A"＆suppno）supName ""の場合はWorkbooks.Add ActiveWorkbook.SaveAs supName newWB = ActiveWorkbook.Name Windows（thisWB）。 ActiveSheet.AutoFilterMode = Falseの場合はSelection.AutoFilter Selection.AutoFilterの場合は終了Field：= 2、Criteria1：= "="＆supName、_ Operator：= xlAnd、Criteria2：= "" lastrow = Cells（Rows.Count、2）.End（xlUp）.Row Rows（ "1："＆lastrow）.Windows（newWB）をコピーします。ActiveSheetをアクティブにします。ActiveWorkbookをアクティブにします。シートを削除（ "Sheet1"）。ActiveSheet.AutoFilterModeの次にセルを選択します。ActiveSheet.ShowAllDataを選択します。 

このヒントを提供してくれたRizvisa1に感謝します。