マクロで住所録を抽出して、別シートにコピーするのに

質問

マクロで住所録を抽出して、別シートに抽出したデータをバラバラに貼り付けたいです。
当方、マクロ初心者なので、分かりやすく教えてください。

シート1『入力シート』、シート2『印刷シート』、シート3に『客先住所録』とあって、今までは住所録のデータをセル1つずつをコピーしてシート1の入力シートに貼り付けて、シート1から2へは関数の=セル番号として飛ばして、シート2の印刷シートを印刷していました。

せっかく、住所録があるからなんとか簡単にならないかと言われて、初心者ながらマクロを作成しました。住所録のオートフィルタで抽出まではうまく出来たのですが、入力シートにコピー貼付が作成時に抽出した住所録は出来ますが、それ以外の住所で抽出すると出来ません。
どうすれば、いいのかご教授願います。

シート３『客先住所録』
A1
チェック
Ａ２
1
Ａ３ Ｂ３ Ｃ３ Ｄ４ Ｅ４ Ｆ４
１又は空白 会社名 〒 住所 ＦＡＸ ＴＥＬ
以下７０件ほど住所録入力あり。

シート１『入力シート』
Ｇ４に〒 Ｇ５に住所 Ｋ６に電話番号 Ｙ６にＦＡＸ Ｇ７に会社名
にコピーしたいです。

自分が作成したマクロは
Range("A3:F70").Select
Range("A3:F48").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Range("A1:A2"), Unique:=False
Range("B7").Select
Selection.Copy
Sheets("入力シート").Select
Range("G7:AF7").Select
ActiveSheet.Paste
Sheets("客先住所録").Select
Range("C7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("入力シート").Select
Range("I4:AH4").Select
ActiveSheet.Paste
Sheets("客先住所録").Select
Range("D7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("入力シート").Select
Range("G5:AH5").Select
ActiveSheet.Paste
Sheets("客先住所録").Select
Range("E7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("入力シート").Select
Range("K6:T6").Select
ActiveSheet.Paste
Sheets("客先住所録").Select
Range("F7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("入力シート").Select
Range("Y6:AH6").Select
ActiveSheet.Paste
End Sub

どう治せば良いのか、宜しくお願いします。

宜しくお願いします。

回答No.1

queuerev2

回答者様のコードのフィルタの部分を生かして作ってみましたがいかがでしょうか？
（If MsgBox から Exit For までの部分を印刷処理等に書き換えてください）
Sub datawritetest()
Dim WB As Workbook
Dim S1 As Worksheet, S3 As Worksheet
Dim R1 As Range, e As Range
Set WB = ThisWorkbook 'マクロとシートが同じブックにある場合の設定。
Set S1 = WB.Sheets("入力シート")
Set S3 = WB.Sheets("客先住所録")
S1.Activate '「入力シート」目視確認のためであり必須でない
S3.Range("A3:F48").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
S3.Range("A1:A2"), Unique:=False
S3.Range("1:3").Rows.Hidden = True '客先住所録の1-3行目を不可視にし、
Set R1 = S3.Range("a3").CurrentRegion.SpecialCells(xlVisible)
S3.Range("1:3").Rows.Hidden = False '可視セルのみを選んで不可視を戻す
For Each e In R1.Rows '客先住所録で選択された領域を1行ずつ処理
S1.Range("g4").Value = e.Offset(0, 2).Value
S1.Range("g5").Value = e.Offset(0, 3).Value
S1.Range("k6").Value = e.Offset(0, 5).Value
S1.Range("y6").Value = e.Offset(0, 4).Value
S1.Range("g7").Value = e.Offset(0, 1).Value
If MsgBox(e.Row & "行目のデータを書き込みました。続けますか？", _
vbYesNo) <> vbYes Then Exit For '印刷処理等に書き換える
Next
End Sub