指定文字のみSheet1からSheet2へコピー

ExcelSheet1に表ー１のように氏名の列に記号が入力されています。
B列の指定記号（A,C,F,H）のみSheet2にVBAコードにてコピーしたいのですが。
尚、A列氏名は元々入力されています。
因みに、Sheet2の先頭列がSheet1と同様ですがコピー位置がE1等、任意に設定したいのですが。
どなたか解る方よろしくお願いします。

※添付画像が削除されました。

No.2 ベストアンサー 回答者： hallo-2007 回答日時： 2013/07/27 18:30

>sheet2へ列をずらして(先頭列CをFへ)コピーできないでしょうか。

どうかよろしくお願いします。

Sub ボタン1_Click()
Dim r As Range
ST = InputBox("元データの列")
EN = InputBox("挿入先の列")
For Each r In Range(ST & "1:" & ST & 10)
If WorksheetFunction.CountIf(Range("B10:B20"), r.Value) Then
Sheets("sheet2").Range(EN & r.Row).Value = r.Value
Else
Sheets("sheet2").Range(EN & r.Row).Value = ""
End If
Next
End Sub

こういった書き方は参考になるでしょうか。
エラー処理はしていません。
コピーしたい元データ列を取得する方法
データを入れたい列の取得する方法は？
とりあえず　Inputbox　にしましたが。

この回答への補足

有難うございます。元データーの範囲指定はできました。
sheet1のC1:G10範囲をsheet2の同じaddressではなくE1:I10の範囲にデータを出したいのですが。
添付の表では同じセル番地に入力するようになってましたが、sheet2のC,D列に追加項目が発生したためです。
申し訳ありませんがよろしくお願いします。

補足日時：2013/07/28 14:32

No.1 回答者： hallo-2007 回答日時： 2013/07/27 16:12

>Sheet2の先頭列がSheet1と同様ですがコピー位置がE1等、任意に設定したいのですが。

の部分の意味がよくわからないのですが？
とりあえず
Sheet1でコピーしたい範囲を選択しておいて

Sub ボタン1_Click()
Dim r As Range
For Each r In Selection
If WorksheetFunction.CountIf(Range("B12:B16"), r.Value) Then
Sheets("sheet2").Range(r.Address).Value = r.Value
Else
Sheets("sheet2").Range(r.Address).Value = ""
End If
Next
End Sub

意味は、選択した範囲のセルに対して繰り返し
もし、セルの値が、B12~B16にあれば　空白
なければ、セルの値を入れる
といった感じです。
ご希望に合わせて編集してみて下さい。

この回答への補足

有難うございます。範囲を SelectionせずRangeでコード指定できないでしょうか。
また、sheet2へ列をずらして(先頭列CをFへ)コピーできないでしょうか。どうかよろしくお願いします。

補足日時：2013/07/27 18:11