みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセル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の範囲内にはすべて値が入力されています。

よろしくお願いします。

投稿日時 - 2011-03-10 13:19:38

QNo.6583760

すぐに回答ほしいです

質問者が選んだベストアンサー

こんばんは!
こういうことですかね?

>また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 19:32:57

お礼

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

投稿日時 - 2011-03-10 22:50:05

ANo.2

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.3

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 21:15:25

お礼

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

投稿日時 - 2011-03-10 22:46:42

ANo.1

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

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

どうでしょう?。

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

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

質問したいことは?。

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

投稿日時 - 2011-03-10 16:48:23

あなたにオススメの質問