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

質問

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

この投稿のマルチメディアは削除されているためご覧いただけません。

回答No.2

hallo-2007 · ベストアンサー

>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列に追加項目が発生したためです。
申し訳ありませんがよろしくお願いします。

回答No.1

hallo-2007

>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へ)コピーできないでしょうか。どうかよろしくお願いします。