ｄａｔａを取り出し特定の列にコピー

Sheet 1
　A列　　　　B列 　　　　　　　C列　　　　D列　　　E列　　　　　　F列 　　　　　G列
社員No 　日付 　　商品コード 販売個数 顧客No 　　請求月 　　　　　売上
106099 2009/2/2(月) B-1020 　62 　　C165　 　　2009/3/31 　　6,200

Sheet 2
　A列　　　　B列　　　　　　 F列　　　　G列　　　H列　　　　　　K列　　　　　　 N列
社員No 　日付 　　商品コード 販売個数 顧客No 　　請求月 　　　　　売上
106099 2009/2/2(月) B-1020 　62 　　C165　 　　2009/3/31 　　6,200

シート1からシート2へ社員№をいれると商品コードＣ列からＧ列というふうに
転記できないでしょぅか。
Ｓheet2への列は固定です。

A列　　　　B列　　　　　　 F列　　　　G列　　　H列　　　　　　K列　　　　　　 N列

ＣＤＥ列などの列には空白でシート1からシート2へ転記したあとに
ｄａｔａを入力します。vlookupでやるとあやまって上書きしたりすると
こわれてしまい、ＶＢＡでやればｺｰﾄﾞは別ですから。
なんとか、できるかたいましたら教えてください

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

• 

  For i = 1 To 10
  mydic.Add Sheets("sheet1").Cells(i, 1).Value, Sheets("sheet1").Cells(i, 2).Resize(, 7).Value
  Next i
  For i = 1 To 10
  Sheets("sheet5").Cells(i, 2).Value = mydic.Item(Sheets("sheet5").Cells(i, 1).Value)
  Next i
  For i = 1 To 10
  Sheets("sheet5").Cells(i, 5).resize(,3).Value = mydic.Item(Sheets("sheet5").Cells(i, 1).Value)
  Next i　　　　　　　　　　　　↑ここの部分を何とかしたい３列くっついてくる

  No.2の回答に寄せられた補足コメントです。 補足日時：2018/04/01 20:46

• 

  なんとかなりませんでしょうか

  No.3の回答に寄せられた補足コメントです。 補足日時：2018/04/01 20:57

No.5 回答者： tom04 回答日時： 2018/04/01 22:03

No。

3で記述した通り、今回の質問に関しては不向きな使い方です。
なぜ「Dictionary」に固執するのか理解に苦しむのですが・・・

いくらコードを投稿しても無意味のようなので
ココで辞退させていただきます。

※　追伸　※
↓のサイトもどうなっているのか、回答した者にとっては気になります。

https://oshiete.goo.ne.jp/qa/10397111.html

この回答へのお礼

申し訳ございません
参考にいたします。

お礼日時：2018/04/01 22:22

No.4 回答者： めぐみん_ 回答日時： 2018/04/01 21:04

何かこの間からDictionaryに拘っているような感じですけど、引っ張り出したいデータが１つであるなら意味はないと思いますよ。

この回答へのお礼

有難うございました。

お礼日時：2018/04/01 22:25

No.3 回答者： tom04 回答日時： 2018/04/01 20:53

No.2です。

ん？
お示しのコードはどこから来たのですか？
なぜ「Dicionary」を使いたいのかよく分かりませんが、
そのようなコードは今回の質問には不向きで、余計に難しくしているだけに思えます。

この回答へのお礼

有難うございました。

お礼日時：2018/04/01 22:22

No.2 回答者： tom04 回答日時： 2018/04/01 20:36

こんばんは！

Sheet2のB列・K列（日付列）の表示形式はあらかじめ好みの表示形式にしておいてください。
一例です。
Sheet2のシートモジュールです。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, wS As Worksheet
If Intersect(Target, Range("A:A")) Is Nothing Or Target.Count > 1 Then Exit Sub
Set wS = Worksheets("Sheet1")
With Target
If .Row > 1 Then
If .Value <> "" Then
Set c = wS.Range("A:A").Find(what:=.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
.Offset(, 1) = c.Offset(, 1)
.Offset(, 5).Resize(, 3).Value = wS.Cells(c.Row, "C").Resize(, 3).Value
.Offset(, 10) = wS.Cells(c.Row, "F")
.Offset(, 12) = wS.Cells(c.Row, "G")
Else
MsgBox "該当データなし"
Exit Sub
End If
Else
.Offset(, 1).Resize(, 12).ClearContents
End If
End If
End With
End Sub

こんな感じではどうでしょうか。m(_ _)m

この回答へのお礼

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

お礼日時：2018/04/01 22:24

No.1 回答者： fujillin 回答日時： 2018/04/01 18:11

こんにちは。

＞vlookupでやるとあやまって上書きしたりするとこわれてしまい～
そのようなときのために、エクセルにはシートの保護という機能が用意されています。

この回答へのお礼

有難うございました。

お礼日時：2018/04/01 22:23