今だけ人気マンガ100円レンタル特集♪

教えていただきたいです。
エクセルで複数シートがありそれぞれのシートには表があり、ある項目のところをフィルタで抽出して別ファイルにして値にして名前をつけて保存させたいのです。
(例)項目を店舗名としたとき、全てのシートに店舗名という項目はあり(表の大きさ、項目の数は異なります)店舗名A商店からG商店があるとして、その店舗ごとに全てのシートそれぞれフィルタして(他店舗は消す)店舗ごとのファイルを名前をつけて値にして保存して作成させたいのです。

今はA商店のファイルを作成するときは項目名のところでフィルタでA商店以外を表示させてまず全部削除したらA商店だけの表になります。その作業をすべてのシートで行い値にして名前を付けて保存していきます。かなり時間かかります。
マクロを作成したいのですが、教えていただけたら助かります。

質問者からの補足コメント

  • どう思う?

    すみません。アバウトすぎて・・・
    図の元のファイルは上側でシートが3つあります。
    数量シートはC3をフィルタしてA商店に絞ると下側の表になります。
    同様に他の2つのシートも店舗名をフィルタしてA商店で絞りファイル名はA商店として保存します。
    ただし、3つのシートの表は全く同じではなく店舗名の項目も同じ位置ではないです。
    それぞれ同様に商店ごとのファイルを作成させたいのです。
    A商店からF商店まであったとしたら6つのファイルを作成させるということです。
    質問わかっていただけましたでしょうか。

    「エクセルで抽出して別ファイル作成するのを」の補足画像1
      補足日時:2020/04/27 18:34

A 回答 (4件)

投稿して気が付きましたが、


>値にして
thisBK.Sheets(j).Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy WB.Sheets(j).Range("A1")
ここは、自身で直してください。
    • good
    • 0

こんばんは、


>ただし、3つのシートの表は全く同じではなく店舗名の項目も同じ位置ではないです。
さすがにまだアバウトですね。同じでないなら、示さなければ中々アドバイスはできません。
>マクロを作成したいのですが、教えていただけたら助かります。
ソースコードなどが示されていないのでどこからアドバイスすれば良いか分かりません。

手順でしょうか?
想像の範疇を超えませんが、あくまで一例として
①店舗項目の重複しないリストを作る。(配列など)*Sheets(1)が良さそう?
②新規ブックを3シートで作成する
③店舗項目にリストでフィルタをかける *この場所が不明(補足にもない)
④対象シートの可視セルをコピー新規ブックの対象シートにペーストする
⑤シート数③④を繰り返す
⑥新規ブックにリスト名で保存し閉じる
⑦リストの数だけ②~⑥を繰り返す

参考コード書いたほうが良いか悩みましたが、一応 書いてみました。うまく完了すれば良いのですが、、
解らないかも知れませんが、内容を必ず確認してコピーファイルなどで試してください。

仕様は下記条件
>シートが3つあります。 
*3シートの新規ブックを作成します

>~商店で絞りファイル名はA商店として保存します。
キーワードをファイル名にします。*ただしすでに同名ファイルがある時の処理は割愛(ご自身で)

>同じではなく店舗名の項目も同じ位置ではないです
画像だと店舗、ご質問だと店舗名、、、果たしてどちらか? *店舗とします。(各シートにこの見出しが必ずある事)

>商店ごとのファイルを作成させたい
作成してデスクトップにキーワードで保存します。

>A商店からF商店まであったとしたら6つのファイルを作成
キーワードの数は制限なし *ただし、メモリースタックの可能性はあります。

*処理は比較的重いと思います。

Sub ANS()
Dim Rng
Dim i As Long, j As Integer: j = 0
Dim Key_list As New Collection, KeyItem()
Dim Temp As Integer
Dim thisBK As Workbook, WB As Workbook
    Set thisBK = ThisWorkbook
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual
    End With
    On Error Resume Next
    Rng = TargetRng(1)
    With Sheets(1)
        For i = 4 To .Cells(Rows.Count, Rng(2)).End(xlUp).Row
            On Error Resume Next
            Key_list.Add .Cells(i, Rng(2)).Value, CStr(.Cells(i, Rng(2)).Value)
            If Err.Number = 0 Then
                ReDim Preserve KeyItem(j)
                KeyItem(j) = .Cells(i, Rng(2)).Value
                j = j + 1
            End If
            On Error GoTo 0
        Next
    End With
    Temp = Application.SheetsInNewWorkbook
    For i = 0 To UBound(KeyItem)
        Application.SheetsInNewWorkbook = 3
        Set WB = Workbooks.Add
        thisBK.Activate
        For j = 1 To 3
            Rng = TargetRng(j)
            thisBK.Sheets(j).Range(Rng(0)).Offset(1).AutoFilter 1, KeyItem(i)
            thisBK.Sheets(j).Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy WB.Sheets(j).Range("A1")
            thisBK.Sheets(j).Cells.AutoFilter
        Next
        WB.SaveAs Filename:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & KeyItem(i) & ".xlsx"
        WB.Close
        Set WB = Nothing
    Next
    Application.SheetsInNewWorkbook = Temp
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
        .Calculation = xlCalculationAutomatic
    End With
    MsgBox ("完了")
End Sub
Function TargetRng(ShtIdx As Integer) As Variant
Dim K_Rng As Range, RngData(2)
Dim thisBK As Workbook
    Set thisBK = ThisWorkbook
    Set K_Rng = thisBK.Sheets(ShtIdx).Cells.Find(What:="店舗", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, MatchByte:=False)
    RngData(0) = K_Rng.Address(0, 0)
    RngData(1) = K_Rng.Row
    RngData(2) = K_Rng.Column
    TargetRng = RngData
    Set thisBK = Nothing
    Set K_Rng = Nothing
End Function

*ネット上に挙がっているプログラムを分からず実行するのは危険です。
悪意あるソースコードもありますので、自己責任でお願いします。
    • good
    • 1

こんにちは



ご質問が抽象的過ぎて(なさりたいことはわかりますが)、とてもコードにはなりません。
せいぜい言えるのは
1)「マクロの記録」機能を利用して、「A商店」についての処理を記録します。
2)できた記録のなかの「A商店」の部分を変数にして、変数の内容を変えれば他の商店に対しても処理できるように変更ます。
くらいでしょうか。

必ずしも効率的なコードになるとは限りませんが、一応、使えるものにはなると思います。
コツとしては、記録を取る際には「無駄な操作は全て省く」ことでしょうか。
    • good
    • 0

そんなアバウトな質問の仕方では解答は得られないですよ。



プログラム(今回はマクロ)は、どの場所の何をどこからどこまでどのように行う、と言う組み合わせで出来ていますから、それを明確に相手にわかるように画像と文章で伝えないと回答したくても出来ないですよ。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング