エクセルでシート1に会員名簿を作成しました。解約した人、入会の方をシート2.シート3に振り分けたいの

エクセルでシート1に会員名簿を作成しました。解約した人、入会の方をシート2.シート3に振り分けたいのですかがやり方教えて下さい。

会員番号 店舗番号 店舗名 解約は1．入会は2 氏名 住所........等13項目あります。
解約の2と入会の1で別シートに振り分けしたいです。
宜しくお願いします。

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

• tatsu99さん、ありがとうございます。
  1行目には、見出しがあります。
  D列には、1か2が必ず入っています。
  今は、フィルターをかけて1か2を選択出来るようにしています。
  それを1の方が2になった時、自動的に2の解約者のシートに行くようにしたいのです。
  解約者は、又、再入会する可能性があるので
  別シートに寄せたいのです。
  宜しくお願いします。

    補足日時：2016/10/17 10:23

No.1 回答者： aaassa 回答日時： 2016/10/15 17:32

解約と入会で番号が違うなら、フィルターで振り分けてはいかがですか？

それをコピーして、別シートに貼り付けると。

この回答へのお礼

ありがとうございます。
現在、その方法で行っています。

お礼日時：2016/10/17 10:24

No.2 回答者： 銀鱗 回答日時： 2016/10/15 18:11

シート1の複製を2つ作り、

それぞれ解約、入会で並べ替えた後
該当しないデータをまとめて削除

この回答へのお礼

ありがとうございました。

お礼日時：2016/10/17 10:27

No.3 回答者： tatsu99 回答日時： 2016/10/15 21:53

マクロを作ればできますが、その前提として、行、列の情報がどのようになっているか教えてください。

質問1：1行目は見出しですか？　それともいきなりデータですか？

質問2：解約は1．入会は2とのことですが、それは、D列に１又は２が格納されていると理解して良いですか。（必ず１，２の何れかであり、１，２以外の数字が格納されていることはあり得ない）

No.4 回答者： googoo900 回答日時： 2016/10/16 00:02

別シートに分ける必要ありません。

別シートに分けてしまうと、今後解約・入会がでるたびに複数のシートを更新する必要があり、非効率です。
フィルタ機能を使えば１枚のリスト(シート)で管理できます。

◆やり方
1.　会員番号等が記入してある行を選択
2.　メニューの　データ→フィルタ　をクリック
3.　解約・入会が記入してあるセルの▼マークをクリック
4.　表示したいものに✔をいれる

どうしても分ける必要があるなら、フィルタを掛けた状態でコピーして、別シートに貼りつければよいです。

この回答へのお礼

ありがとうございます。
現在、その方法で行っています。
それ意外で自動的に振り分け出来ないかと思い投稿しました。

お礼日時：2016/10/17 10:27

No.5 ベストアンサー 回答者： tatsu99 回答日時： 2016/10/17 11:15

No3です。

以下のようなマクロを作成します。（標準モジュールへ作成）
---------------------------------------------
Option Explicit
'sheet1の情報をsheet2(解約),sheet3(入会)へ振り分けてコピーする
Public Sub Macro1()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim maxrow As Long 'sheet1の最大行数
Dim row As Long '処理中の行
Dim row2 As Long 'Sheet2へコピーする行
Dim row3 As Long 'Sheet3へコピーする行
Dim count As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
Set sh3 = Worksheets("Sheet3")
'最終行を取得
maxrow = sh1.Cells((Rows.count), 1).End(xlUp).row
If maxrow < 2 Then
MsgBox ("行数不足")
Exit Sub
End If
'見出しをコピー
sh1.Rows(1).Copy
sh2.Rows(1).PasteSpecial
sh3.Rows(1).PasteSpecial
row2 = 2
row3 = 2
count = 0
For row = 2 To maxrow
With sh1
'抽出条件をチェック
If .Cells(row, 4).Value = 1 Then
'解約ならsheet2へコピー
sh1.Rows(row).Copy
sh2.Rows(row2).PasteSpecial
row2 = row2 + 1
count = count + 1
Else
If .Cells(row, 4).Value = 2 Then
'入会ならsheet3へコピー
sh1.Rows(row).Copy
sh3.Rows(row3).PasteSpecial
row3 = row3 + 1
count = count + 1
Else
MsgBox (row & "行がデータ不正の為コピースキップしました")
End If
End If
End With
Next
Application.CutCopyMode = False
MsgBox (count & "件コピーしました")
End Sub
---------------------------------------------------------
会員名簿をsheet1
解約をsheet2
入会をsheet3
としています。このシート名を変えたい場合は、適宜、変更してください。
上記のマクロを実行すると、解約と入会とに振り分けられ、sheet2,sheet3へコピーされます。
（sheet2,sheet3は上書きされます）

この回答へのお礼

回答ありがとうございます。
解説も付けていただいてよくわかります、。
明日、やってみます。

お礼日時：2016/10/17 12:26