抽出→書込み？ コピー→貼付？ 教えてください。

質問

ＶＢの勉強中の初心者です。

Sheet1（科目別の集計抽出を行っている）

U1:AC1は見出し
------------------------------------------
果物｜ブドウ｜産地｜........｜計900円｜（元データ列：U2:AC2）
------------------------------------------
......
果物｜ミカン｜産地｜農家｜....計800円｜（元データ行：U71:AC140）
------------------------------------------
野菜｜......農家｜3個｜120円｜計360円｜（データ列：U141:AC220）
------------------------------------------
......
野菜｜キャベツ｜...｜2個｜200円｜計400円｜（データ列：U141:AC220）
------------------------------------------

果物・野菜＝科目とした場合、科目は12種類あり
列は+70で変化なしです。
この値を、規定の書式にのっとり

Sheet2（科目別の見積書を作成）
科目別見積なので見積シ－トは12枚
------------------------------------------
　　　Ａ　　 Ｂ　 Ｃ　　Ｄ　........　Ｉ
10 "空白" 産地 ２個　.....
12 ブドウ 農家名
------------------------------------------
　　　Ａ　　 Ｂ　 Ｃ　　Ｄ　........　Ｉ
13 "空白" 産地 ２個　.....
14 ブドウ 農家名
------------------------------------------
の様にまとめたいのですが、
１つの項目（ブドウ・ミカン等）に対して
Ａ列は奇数列に表示
Ｂ列のみ２行（産地「奇数列」：農家名「偶数列」）必要とします。
Ｃ列～Ｉ列までは偶数列に表示

項目は行１科目に対して70ですので、
A10～A149までです。
列はＡ～Ｉまです。

Loop ・.Offset・For～Next

Sheet1からコピーして貼り付け
Sheet2に直接記憶マクロ　等
などいろいろ試したのですが処理できないで困っています。
長々と書きましたが、
ＶＢの勉強をはじめたばかりの素人です。
いろいろ調べたのですが自分の学習不足もあってかなかなか
回答に結びつかなかったので質問させてください。
皆様の知恵を貸して下さいよろしくお願いします。

方法は問いません。
Sheet2へうまくSheet1の内容を表示させるにはどのような
マクロにすればよいか教えてください。

よろしくお願いします。

回答No.2

redfox63 · ベストアンサー

見積もり表の構成を1行にするのであれば データ > フィルター > フィルターのオプション
あたりでやれますが 2行構成にしてしまうとVBAになるでしょう

『Microsoft Scripting Runtime』に参照設定しておいて

Sub MacroFruit()
　　dim arData, sv
　　dim dict as new Scripting.Dictionary
　　dim n as integer
　　dim oSrc as Range, oDest as Range

　　arData = Sheets("Sheet1").Range("V2:V71").Value
　　for n = 1 to UBound( arData,1)
　　　　if Dict.Exists( arData( n,1 ) ) = false then
　　　　　　Dict.add arData( n,1 ), arData( n,1 )
　　　　end if
　　next

　　Set oDest = Sheets("Sheet2").Range("A10")
　　for each sv in dict
　　　　for n = 1 to Ubound(arData,1)
　　　　　　if arData(n,1) = sv then
　　　　　　　　Set oSrc = Sheets("Sheet1").Range("V" & n + 1 )
　　　　　　　　oDest.Offset(0,1).value = oSrc.Offset(0,1).value ' 産地
　　　　　　　　oDest.Offset(0,2).Resize(1,7).value = oSrc.Offset(0,3).Resize(1,7).value
　　　　　　　　oDest.Offset(1,0).value = oSrc.value　　　 ' 果物名
　　　　　　　　oDest.Offset(1,1).value = osrc.Offset(0,2) ' 農家
　　　　　　　　' 次の転記位置に更新
　　　　　　　　set oDest = oDest.Offset(2)
　　　　　　end if
　　　　next
　　next
End Sub

といった具合です

他のシートに関しては
　　arData = Sheets("Sheet1").Range("V2:V71").Value
　　Set oSrc = Sheets("Sheet1").Range("V" & n + 1 )
　　Set oDest = Sheets("Sheet2").Range("A10")
の部分の V2:V71や "V" & n + 1の +1、Sheets("Sheet2")などを修正してください

お礼

redfox63さん回答ありがとうございます。
思っていた通りに処理出来ました。

素人の私にとってはこれから内容を一つづつ
理解してこれらからの勉強に役立てるのが課題として
残りました。

その他の作業を含め進めていく上で私自身で解決できない課題が
ありましたら、その時はアドバイスをお願いします。

本当にありがとうございます。

回答No.1

n-jun

シート1の１行のデータをシート２に２行で表示したいというように、
思ったのですが。。。
どのセルのデータをどこに入れていくのか？今一つわかりません。

>コピーして貼り付け
値だけで良いのであれば
例：　Sheets("Shhet2").Range("A1").Value　=　_
　　　Sheets("SHeet1").Range("A1").Value
とすれば、シート1のＡ１の値がシート２のＡ１に代入されます。
これではまずいのでしょうか？

補足

n-jun回答ありがとうございます。
内容がうまく伝わらず表現不足といいますか....
申し訳ありません。