[[20190804193059]]　『シートのコピーとシート名変更』（Mフィー）　ページの最後に飛ぶ

『シートのコピーとシート名変更』（Mフィー）

 お店別の価格変更表を作りたいのですが、知識が乏しく教えてください。
表1をお店別に別シートにコピーし、シート名を
そのお店の名前にしたいです。
お店の数がたくさんあるため1店ずつ検索してコピーしていくのが
大変な為、なにか簡単にできる方法がありましたらご教示ください。
お店によって商品の数はばらばらです。

（表1）

  A	    B	      C	   　　   D		E	
得意先ｺｰﾄﾞお店　　  商品名	変更前価格  変更後価格
111	  A商店    みかん	  100         130
111	  A商店	   りんご	  150	      160
111       A商店	   いちご	  300	      360
125	  B商店	   みかん	  120         120
125	  B商店	   りんご	  150	      160
134	  C商店	   いちご	  350	      360
134	  C商店	   バナナ	  200	      220
134	  C商店	   めろん	  500	      520
305	  D商店	   みかん	  100	      130
319	  E商店	   バナナ	  200	      220
319	  E商店    めろん	  500	      520
319	  E商店	   みかん	  100	      130

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

マクロでもよければ
（他の質問への回答の再利用で、動作確認していません）
Option Explicit

 Sub test()
    Dim r As Range
    Dim c As Range
    Dim wb As Workbook

    Set r = Range("a1").CurrentRegion
    Set c = r(1).Offset(, r.Columns.Count)

    r.Columns("b").AdvancedFilter xlFilterCopy, , c, True

    Set wb = Workbooks.Add(xlWBATWorksheet)

    Do While c.Offset(1).Value <> ""
        With wb.Worksheets.Add
            .Name = c.Offset(1).Value
            r.AdvancedFilter xlFilterCopy, c.Resize(2), .Range("a1")
        End With
        c.Offset(1).Delete xlShiftUp
    Loop

    c.Resize(2).ClearContents

    Application.DisplayAlerts = False
    wb.Sheets(wb.Sheets.Count).Delete
    Application.DisplayAlerts = True

 End Sub

（マナ） 2019/08/04(日) 20:01

ご回答ありがとうございました。
大変助かりました。
（Mフィー） 2019/08/05(月) 07:46

コメント返信：

[ 一覧(最新更新順) ]

[[20190804193059]] 『シートのコピーとシート名変更』（Mフィー） ページの最後に飛ぶ

[[20190804193059]]　『シートのコピーとシート名変更』（Mフィー）　ページの最後に飛ぶ