エクセルで別シートへ転写するには

質問

すみませんＶＢ初心者で教えてください。
現在 sheet1にＡからＦ列まで４行目から２７行目まで、各データがあるのですが、sheet1にコマンドボタンをつけて、クリックしたら、sheet2へ転記するようにしたいのですが、sheet2もＡからＦまであり４行目からデータがはじまります。問題なのがsheet1でコマンドボタンを押したら、常にデータを付け足ししたいのです。　要はsheet2はデータ台帳にしたいのです。　そしてもう一点　sheet1でコマンドボタンをクリックしてsheet2へ転記がおわったら、sheet1のデータをクリアしたいのですが、すみませんがソースと解説のほうお願いします。大変困っています。

回答No.7

myRange

＞sheet1のＡ列には色がついているのですが、クリアすると色が消えてしまいます

Range("A4:A27").ClearContents

ClearContentsメソッドで書式（色や罫線など）が消える？
それちゃんと確認してから言ってるんでしょうねぇ。
ええかげんなことを言っては困りますよ。

再度試してみるべきです。
それでも消えると言い張るなら、コードをアップ願います。

それから、質問者お得意の「あともう一点」ですが、
最初の質問の内容と全然違いますから、こういった掲示板の性格上、別質問で投稿しなければいけません。

●分からない点があれば上記のようなことを頭に入れた上で、どんどんどんどん質問しましょう。

ＶＢＡ、初めのうちはちょと理解しずらいとこがあるでしょうが、途中で投げ出すに頑張ってほしいものです。

お礼

数々の問題点への回答ありがとうございました。自分でもう少し勉強して
また、質問させていただきます。

回答No.6

myRange

Ａ列の色も、ですね？

なら、次の１行を追加してください。

.Cells(LastRow + 1, "A").Interior.ColorIndex = _
Cells(R, "A").Interior.ColorIndex

以上ここまで。

お礼

すみません質問がわるかったみたいで。再度質問させてください。　　
sheet１からsheet2への転記のあと、クリア処理をします。そのとき、sheet1のＡ列には色がついているのですが、クリアすると色が消えてしまいます。ただ、色はsheet2へは転記したいのではなく、sheet1のＡ列の色がクリア処理で消えないようにしたいだけです。

それともう一点だけ、追加質問させてください。
sheet1のA列が行単位で何らか入力されている時は、Ｇ列の行の値は消さず、Ａ列は空白した場合、Ｇ列も空白にするというソースを書いてみたのですが、作動しません。一度みてください。　
自分のやった手順ですがsheet１でＡＬＴ　Ｆ１１をおして
sheet1で　左がgeneral 右がDeclarationsの状態で
　　For R = 4 To 27
If Cells(R, "A").Value ="" & Cells(R,"G").Value<>"" Then
With Sheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Cells(LastRow + 1, "G").Value = Cells(R, "H").Value
Ｈのセルは常に絶対空白だから　Ｇのセルが空白になると思ったのですが、ご指導お願いします。

回答No.5

myRange

回答４、myrangeです。

＞sheet1のセルＢには関数がはいっており

これからも質問することがあるかと思いますが、
上記のような大事なことは最初から提示するように心掛けましょう。
とは言っても、初めのうちはそこら辺りに気づくのはなかなかでしょうが。

で、続きの回答。

Ｂ４～２７までは式が入っているので残したいということですね。
で、あれば次のようにしてください。

＞Range("A4:F27").ClearContents

を削除して、

Range("A4:A27").ClearContents
Range("C4:F27").ClearContents

とする。
以上ここまで。

お礼

ありがとうございました。大変勉強になりました。　最後に一点だけ質問させてください　Sheet1のA列のセルには色がついているのですが、Sheet2へ転記すると色も消えてしまいますが、色は保護することは可能でしょうか？

回答No.4

myRange

おお、ちゃんと後始末したようですね。
なら、アドバイスしないわけにはいきませんねぇ。(^^;;;

（処理内容）
ボタンのあるシート（仮に、データシート、と呼ぶ）から
ボタンをクリックして、"納入管理表"シートへデータ転記する
転記終了時に、データシートのデータは消去する
データシートは、Ａ４～Ｆ２７までをデータに使用している
納入管理表シートには、４行目から転記する

以上のことを踏まえて、、、

'----------------------------------------------
Sub ボタン30_Click()
　Dim R As Long
　Dim LastRow As Long

　For R = 4 To 27
　　If Cells(R, "A").Value <> "" Then
　　　With Sheets("納入管理表")
　　　LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
　　　.Cells(LastRow + 1, "A").Value = Cells(R, "A").Value
　　　.Cells(LastRow + 1, "B").Value = Cells(R, "B").Value
　　　.Cells(LastRow + 1, "C").Value = Cells(R, "C").Value
　　　.Cells(LastRow + 1, "D").Value = Cells(R, "D").Value
　　　.Cells(LastRow + 1, "E").Value = Cells(R, "E").Value
　　　.Cells(LastRow + 1, "F").Value = Cells(R, "F").Value
　　　End With
　　End If
　Next R

　Range("A4:F27").ClearContents
End Sub
'---------------------------------------------------

なお、転記部分の６行は
.Cells(LastRow + 1, "A").Resize(1, 6).Value = Cells(R, "A").Resize(1, 6).Value
この一行でもできますが、いままだ考えなくていいでしょう。

それから、不明の点はそれを明確に提示して再度質問のこと。
以上ここまで。

お礼

ありがとうございます。やりたい事が全てやれました。　
ただ、一点だけ問題が起こってしまったので再度教えていただきたいのですが、sheet1のセルＢには関数がはいっており、関数まで消えてしまうのは大変困ってしまいます。　その関数は保護することはできるでしょうか？　ちなみにその関数は以下のとおりです。
=IF(OR(A4="",ISERROR(VLOOKUP(A4,商品一覧!$A:$F,3,FALSE))),"",VLOOKUP(A4,商品一覧!$A:$F,3,FALSE))
上記の関数で別シートからデータをひっぱてきています。数値だけクリアして関数は保護することは可能でしょうか？　ご指導おねがいします。

回答No.3

imogasi

（１）コマンドボタンのクリックのイベントがどうなるかわかるよね。コード例でわかっているようだ。
（２）コピー元のセル範囲の捉え方は、どう考えているの
Sheet1のデータは
A-F列（固定？）にあり（＜＝sheet2も、から）、
４行目から入力データが始まり、
最下行は場合場合で変動するのだろうね。
Sub test01()
d = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
Range("A4:F" & d).Select
End Sub
をテストでやって、望みのセル範囲を捉えていることを納得のこと。
確認のときシートタブSheet1をクリックしないと、セル範囲をクリックしてはダメ。またこの方法以外にCurrentRegionなど方法が数種ある。
ーー
（３）この範囲をコピーする
Sub test01()
d = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
Range("A4:F" & d).Copy
End Sub
で点線枠がブリンクするよね。
（４）これをシートSheet2に貼り付けるが、前回までの累積行の最後の次にやる点が注意で、この辺が質問者に判ら無かったのじゃないかな。
それはSheet1の最終行を捉えるときに使った
Worksheets("Sheet1").Range("A65536").End(xlUp).Row
が使える。Sheet2だから変えて、またシートを明示的に区別して表現して（この点も質問者には思いつきにくいだろう）
Sub test01()
Set sh1 = Worksheets("Sheet1")
D1 = sh1.Range("A65536").End(xlUp).Row
sh1.Range("A4:F" & D1).Copy
Set sh2 = Worksheets("Sheet2")
D2 = sh2.Range("A65536").End(xlUp).Row
sh2.Range("A" & D2 + 1).Select
End Sub
（５）最後に貼り付けだが、Destinationを使うのが便利（左上隅
のセルを指定するだけでよいから）
前後関係を整えて
Sub test02()
Set sh1 = Worksheets("Sheet1")
D1 = sh1.Range("A65536").End(xlUp).Row
'--
Set sh2 = Worksheets("Sheet2")
D2 = sh2.Range("A65536").End(xlUp).Row
'--
sh1.Range("A4:F" & D1).Copy sh2.Range("A" & D2 + 1)
End Sub
（６）Sheet1を消すのは（２）で消す範囲が捉えられるから
Sub test03()
Set sh1 = Worksheets("Sheet1")
D1 = sh1.Range("A65536").End(xlUp).Row
sh1.Range("A3:F" & D1).Clear
End Sub
を納得し、終わりに付け加えればよい。
＝＝＝
以上は、マクロの記録をとってみれば、この課題のコードの概略が判る。初心者と言いながら、マクロの記録をとって勉強もせずに、丸投げ質問してはいけない。マクロの記録で、上記でD1とD2の係わるコードの箇所だけが変えるべきとことで、そこをどう変えたらよいかぐらいの質問にまで絞れるはずだ。
質問者はこの課題をしようとするのが、無理な状態だと思う。皆、半年ぐらいは、本など読んで思考・試行しているとおもう。

お礼

細かいところまで親切に教えていただいてありがとうございました。

回答No.2

myRange

こら、こら、

http://okwave.jp/qa4942780.html
http://okwave.jp/qa4982122.html

先ず、この放ったらかしの質問をどうにかするべきでは？
見ず知らずの質問者のために時間を割いて回答してあげてる人に申し訳ないと思わないのだろうか。
ま、思わないから、放ったままにしてるのだろうが。
マナーが悪いなぁ。

　　スタッフ～～～

お礼

すみませんでした。　お礼をするのを忘れていました。なんとか教えていただくことは可能でしょうか？

回答No.1

Sinogi

説明が回りくどい割に要領を得ず丸投げではソースと解説を受けても活用できるのか疑問です。
Sheet1のＡ～Ｆ列の４行目から最終行をSheet2のＡ～Ｆ列の最終行以降にコピー/転記し、Sheet1の該当行をクリアしたいのでしょうか。
まずはすべての操作をマクロ記録して、動作を再現し、希望の動作にならないところを確認してから自分で考えたのち解決しないのならその部分を具体的に質問するのがよいでしょう。

困った時に自力で可決できたことはいろいろ応用ができるようになるものです

お礼

すみません。　私は以下のようにつくりましたが、うまく動かず、更に処理がとても重い感じがします。クリアについては全くわからない状態です。アドバイスお願いします。
Sub ボタン30_Click()
Dim LastRow As Long
Dim R As Long

Application.EnableEvents = False
Application.ScreenUpdating = False

For R = 4 To 26 Step 1
If Cells(R, "A").Value <> "" Then
With Sheets("納入管理表")
LastRow = .Cells(Rows.Count, "B").End(xlUp).Row + 1
.Cells(LastRow, "C").Value = Cells(R + 1, "C").Value
.Cells(LastRow, "B").Value = Cells(R + 1, "B").Value
.Cells(LastRow, "A").Value = Cells(R + 1, "A").Value
.Cells(LastRow, "D").Value = Cells(R + 1, "D").Value

End With
End If
Next R
End Sub