エクセルVBAの入力について

"Sheet1"のA1、C1、F1、G1の値(計算結果のみ)すべてコピーして、
貼り付ける場所が"Sheet2"のA1：Z10の範囲内で、
A1はB列、C1はG列、F1はH列、G1はZ列の空白セルに上詰めで貼り付ける。
なおF、G、H、Z列以外の列には値が入力されていたり空白もあります。

また同時に、
"Sheet1"のA1、C1、F1、G1の値(計算結果のみ)の内でA1とF1のみコピーして、
貼り付ける場所が"Sheet3"のC1：Y10の範囲とC13：Y23範囲内で、
A1はC列、F1はY列の空白セルに上詰めで貼り付ける。
なおC、Y列以外の列には値が入力されていたり空白もあります。
またC11：Y12の範囲内にはすべて値が入力されています。

よろしくお願いします。

No.2 ベストアンサー 回答者： tom04 回答日時： 2011/03/10 19:32

こんばんは！

こういうことですかね？

＞またC11：Y12の範囲内にはすべて値が入力されています
とありますがそれはあまり考えなくても良いように思われます。

コピーのコードではないのですが・・・

Sub test()
Dim i As Long
Dim ws1, ws2, ws3 As Worksheet
Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
Set ws3 = Worksheets("sheet3")
i = 1
Do Until ws2.Range("B" & i) = ""
i = i + 1
Loop
ws2.Range("B" & i) = ws1.Range("A1")
i = 1
Do Until ws2.Range("G" & i) = ""
i = i + 1
Loop
ws2.Range("G" & i) = ws1.Range("C1")
i = 1
Do Until ws2.Range("H" & i) = ""
i = i + 1
Loop
ws2.Range("H" & i) = ws1.Range("F1")
i = 1
Do Until ws2.Range("Z" & i) = ""
i = i + 1
Loop
ws2.Range("Z" & i) = ws1.Range("G1")

i = 1
Do Until ws3.Range("C" & i) = ""
i = i + 1
Loop
ws3.Range("C" & i) = ws1.Range("A1")
i = 1
Do Until ws3.Range("Y" & i) = ""
i = i + 1
Loop
ws3.Range("Y" & i) = ws1.Range("F1")
End Sub

外していたらごめんなさいね。m(__)m

この回答へのお礼

質問に対して批判がある中、
丁寧な回答をして頂きありがとうございました。
まったく外していません。
思ったとおりの動作が可能となり大変満足しています。

お礼日時：2011/03/10 22:50

No.3 回答者： mar00 回答日時： 2011/03/10 21:15

Sub Macro3()

INP1 = Sheets("Sheet1").Range("A1")
INP2 = Sheets("Sheet1").Range("C1")
INP3 = Sheets("Sheet1").Range("F1")
INP4 = Sheets("Sheet1").Range("G1")

Sheets("Sheet2").Select
AA = Sheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row
If Range("B1") = "" Then
GYOU = 1
Else
GYOU = Cells(Rows.Count, 2).End(xlUp).Row + 1
End If

If GYOU <= 10 Then
Range("B" & GYOU) = INP1
Range("G" & GYOU) = INP2
Range("H" & GYOU) = INP3
Range("Z" & GYOU) = INP4
Sheets("Sheet3").Range("C" & GYOU) = INP1
Sheets("Sheet3").Range("Y" & GYOU) = INP3
Else
Sheets("Sheet3").Select
If Cells(Rows.Count, 3).End(xlUp).Row + 1 < 24 Then
Range("C" & Cells(Rows.Count, 3).End(xlUp).Row + 1) = INP1
Range("Y" & Cells(Rows.Count, 3).End(xlUp).Row + 1) = INP3
End If
End If
End Sub

Sheet2は10行目まで、Sheet3は10行目までと13～23行目まで埋まると
何もしないようにしてあります。

この回答へのお礼

ありがとうございました。質問に対して批判がある中、
丁寧な回答をして頂きありがとうございました。
思ったとおりの動作が出来て大変うれしく思っています。

お礼日時：2011/03/10 22:46

No.1 回答者： layy 回答日時： 2011/03/10 16:48

何に対して、よろしくお願いします、なのか？？。

投稿したら誰かが作ってくれるだろう、なんだろうし、確かに誰かが作ってベストアンサー、と思う。
さらにまた同じことの繰り返しで質問と回答？。

どうでしょう？。

結果だけ先行して、自身の力付かない、ついてないなんてことにならないように・・。

エクセルＶＢＡいろいろやってるしお願いしてみよう、と依頼されるとホントに１から誰かに作ってもらわないとできなくなる。やり方間違うと苦しむのは自分。

質問したいことは？。

どこから始めたらいいかわかりませんというのも質問ですが。