VBA作製ができません。どなたか教えてください。

質問

エクセルVBA作製ができません。どなたか教えてください。
会社の作業単純化のためにVBA作製しようと思ったものの、うまくできません。出来る方ならすぐ出来てしまうのではと思い質問させていただきます。

作りたいのは１つのファイル「Book1」にあるデータをコマンドボタンを押すと「Book2」にコピーさせたいのですが、
条件がありまして、
「Book1」には横並びに5個のセルに数字がそれぞれ入っていたり、いなかったりするのですが、
5個のうちいちばん左のセルに数字が入っていたら実行、入っていなかったらその右のセルにセルを移動するという式if then？で場合分けをしたいです。
そして、もし実行ならその数字や他の任意のＡ１、Ｇ４、Ｈ６（ちなみＡ１、Ｇ４、Ｈ６は文字）など指定したセルをコピーして「Book2」にペーストしたいです。
しかしそこでペーストする先の指定したセルに文字が入っていたらその
下のセルにペーストという条件も加えたいです。ここでloopを使う？
コピーペースト出来たら、また、「Book1」のいちばん左の右のセルに数字が入っているかどうかでコピーペーストをするという作業を繰り返したいです。なのでいちばん最初にFor Nextで５回繰り返す式を入れる？

要はBook1の５個の数字を参照していってセルに入力されていれば
数字や他の文字をBook2にペーストしたいんです。どなたかVBAの式を教えてください。
宜しくお願いします。

回答No.2

haichicchi

#1です。
要求事項を勘違いしていた気がします。
・データ無かったら次の列を見る　のではなく、数字でなかったら次の列を見る
・Book2にはあらかじめ何か書いてあるかもしれないので空いたセルを探す
という条件で修正してみました。

Dim i As Integer　　'行
Dim j As Integer　　'列
Dim k As Integer　　'Book2の行
Dim Data1 As String　　'検索するデータ
Dim DataA As String　　'Ａ１セルのデータ
Dim Data2 As String　　'Book2のセルの内容チェック用

k = 1
For i = 2 To 10 '２行目から１０行目まで繰り返し
　　For j = 1 To 5 '１列目から５列目まで繰り返し
　　　　Data1 = Val(Workbooks("Book1.xls").Worksheets("Sheet1").Cells(i, j).Value)
　　　　If Data1 > 0 Then '数字か？
　　　　'数字以外で必要なデータを取得（仮にＡ１のセルとする）
　　　　DataA = Trim(Workbooks("Book1.xls").Worksheets("Sheet1").Cells(1, 1).Value)
　　　　Do
　　　　'Book2の空いているセルを探す。
　　　　　　Data2 = Trim(Workbooks("Book2.xls").Worksheets("sheet2").Cells(k, 1).Value)
　　　　　　If Data2 = "" Then
　　　　　　　　'Book2に貼り付ける。
　　　　　　　　Workbooks("Book2.xls").Worksheets("Sheet2").Cells(k, 1).Value = Data1
　　　　　　　　Workbooks("Book2.xls").Worksheets("Sheet2").Cells(k, 2).Value = DataA
　　　　　　　　Exit Do
　　　　　　End If
　　　　　　k = k + 1
　　　　　Loop　　'やはりLoopを使います！
　　　　End If
　　Next j
Next i
MsgBox ("おわり")

Ａ１セルから取ったデータは２列目に入れていますが、１列目に入れるのならLoop部分を工夫してください。
意図するものと多少違うかもしれませんが、これを参考にやってみてくださいね。

お礼

回答していただきありがとうございます。
教えていただいた式を頼りにいろいろやってみたいと思います。
ただ、やろうと思ったセルが結合されたセルだったので
まだまだ工夫しなければ出来なそうです。

回答No.1

haichicchi

Book1　で行と列の両方でループが必要ですね。
こんな感じ。

Dim i As Integer　　'行
Dim j As Integer　　'列
Dim k As Integer　　'Book2の行
Dim Data1 As String　　'取得するデータ

k = 1
For i = 2 To 10　　'２行目から５行目まで繰り返し
　For j = 1 To 5　　'１列目から５列目まで繰り返し
　　Data1=Trim(Workbooks("Book1.xls").Worksheets("Sheet1").Cells(i, j).Value)
　　If Data1 <> "" Then
　　　　'Book2に貼り付ける。必要なら他のデータもペーストする。
　　　　Workbooks("Book2.xls").Worksheets("Sheet2").Cells(k, 1).Value = Data1
　　　　k = k + 1
　　　　Exit For
　　End If
　Next j
Next i