別シートへ飛ばす

質問

エクセルの関数またはマクロでどうしたらできるのでしょうか？

内容ですが、元データはsheet1にA4に整理番号があり、B4に識別番号があり、C4に名前があり、D4にフリガナがあり、E4に区分があります。
ここでE4セルにある数種類（1～6）の区分から、1と2であれば、その左のセルの情報A4B4C4D4がsheet2のA4～E4へ上から順番に埋まっていくように飛ばすにはどうしたらいいでしょうか？

たくさん羅列してあるデータから条件を満たしている人が別シートの上から順に埋めていきたいのです。

宜しくお願いします。

回答No.2

KURUMITO

作業列を作って対応するのが分かり易く簡単です。
Ｆ4セルに次の式を入力して下方にドラッグコピーします。

=IF(OR(E4=1,E4=2),MAX(F$3:F3)+1,"")

シート2のＡ4セルには次の式を入力してＥ4セルまで横にドラッグコピーしたのちに下方にもドラッグコピーします。

=IF(ROW(A1)>MAX(Sheet1!$F:$F),"",INDEX(Sheet1!$A:$E,MATCH(ROW(A1),Sheet1!$F:$F,0),COLUMN(A1)))

お礼

ありがとうございます。
実は区分の部分の条件1と2が数字だけではなくて、要支援1と要支援2を入れていのですが、エラーになってしまいます。式も少しさわってみたのですが、うまくいきません。どのように修正したらよいのでしょうか？

回答No.1

noname#212067

はじめまして、こんにちは

マクロですと以下の処理で出来ます
基本だけですので、必要な部分を変更して使用してください。
※打ち間違えるとSHEET１を書き換えてしまう場合がありますので、必ずバックアップを取って実行押してください。

Sub Find()
'Cells(行, 列)を指定して使用する
Dim S1R As Long 'シート１の行カウント用変数
Dim S2R As Long 'シート２の行カウント用変数
S1R = 4 'シート１の開始行
S2R = 4 'シート２の開始行
Do Until Sheet1.Cells(S1R, 1) = "" '整理番号が空欄だったら処理を終わる
If Sheet1.Cells(S1R, 5) = 1 Then '区分が１だったら処理を行う
Sheet2.Cells(S2R, 1) = Sheet1.Cells(S1R, 1) 'シート１からシート２へ整理番号を代入する
Sheet2.Cells(S2R, 2) = Sheet1.Cells(S1R, 2) 'シート１からシート２へ名前を代入する
Sheet2.Cells(S2R, 3) = Sheet1.Cells(S1R, 3) 'シート１からシート２へフリガナを代入する
Sheet2.Cells(S2R, 4) = Sheet1.Cells(S1R, 4) 'シート１からシート２へ区分を代入する
S2R = S2R + 1
End If
If Sheet1.Cells(S1R, 5) = 2 Then '区分が２だったら処理を行う
Sheet2.Cells(S2R, 1) = Sheet1.Cells(S1R, 1)
Sheet2.Cells(S2R, 2) = Sheet1.Cells(S1R, 2)
Sheet2.Cells(S2R, 3) = Sheet1.Cells(S1R, 3)
Sheet2.Cells(S2R, 4) = Sheet1.Cells(S1R, 4)
S2R = S2R + 1
End If
S1R = S1R + 1
Loop
End Sub

お礼

ありがとうございます。
早速やってみます。