エクセルVBAで別シートにコピー貼り付け

質問

VBA初心者です。下記のようにプログラムしましたがうまくいかなくて困ってます。どなたかお力をお貸しください。内容としましては輸入Partsのシートからコピーして商品内容確認のシートのセルB17に貼り付けたいです。輸入Partsシートで3列目の空白を探し同じ行の1列目をコピーします。商品内容確認のシートのセルB17にはカーソルは動いているようですが貼りつきません。

Private Sub 商品内容確認2_Click()

If MsgBox("商品内容確認へ移動しますか？", 33, "移動の確認") = 2 Then
MsgBox "処理を中止します。"
Range("A2").Select

Exit Sub

End If

Dim Line As String
Dim Maxrow As String

Worksheets("輸入Parts").Select
Line = 2

Do Until Cells(Line, 1).Value = ""

On Error Resume Next

If Cells(Line, 3).Value = "" Then

Cells(Line, 1).Copy 'コピーする

Maxrow = Worksheets("商品内容確認").Range("B17").End(xlDown).Row + 1

Worksheets("商品内容確認").Range("B" & Maxrow).PasteSpecial Paste:=xlPasteValues '値を貼り付け

End If

On Error GoTo 0

'次の行に移り最後の行まで検索

Line = Line + 1

Loop

Worksheets("商品内容確認").Visible = True
Worksheets("商品内容確認").Select
Worksheets("商品内容確認").Range("B6").Select
Worksheets("商品内容確認").輸入Partsシート2.Visible = True
Worksheets("商品内容確認").輸出Partsシート2.Visible = False
Worksheets("輸入Parts").Visible = False

End Sub

回答No.2

chie65535

＞輸入Partsのシートからコピーして商品内容確認のシートのセルB17に貼り付けたいです。

ふむふむ。

＞Maxrow = Worksheets("商品内容確認").Range("B17").End(xlDown).Row + 1
＞Worksheets("商品内容確認").Range("B" & Maxrow).PasteSpecial Paste:=xlPasteValues '値を貼り付け

何これ。B17に貼り付く訳ないじゃん。

「B列の一番最後を探して、一番最後の行の次の行」に貼り付けようとしてるじゃん。

どっかのマクロを参考にしたんだろうけど、何やってるかも判らずに使ったら、思い通りに動く訳ないじゃんか。

あと、ペーストする時は、ペースト先のワークシートを選択してからペーストしないとエラーになるので、ペーストされずにエラーになって、そのエラーも

On Error Resume Next

で「エラー無視して次に進め」ってやってるから、結果的に「何も貼り付かない」よ。

On Error Resume Next

ってのは「完成してちゃんと動作するまで、決して使ってはならない」のよ。

未完成なのにこんなの入れたら「エラーが出てもエラー表示しない」から「何かエラーが起きても、無かったことになる」ので、自分のプログラムミスに気付けないし、動作しない原因も判らなくなる。

とにかく「初心者はOn Errorは絶対に使うな」って事。使っても良いのは「完成した後」だけ。

とりあえずOn Error Resume Nextをコメントにして（頭に ' （Shift+7）を付ける）実行してみな。何で動かないかが一発で判るから。

回答No.1

Sayakonomimoto

途中途中の
Cells(Line, 3).Value = ""など、
結局どこを表示しているのか分からない状態が多いので

With　Worksheets("輸入Parts")
　　.select
If .Cells(Line, 3).Value = "" Then

Cells(Line, 1).Copy 'コピーする
End with

そして、そもそも値を貼り付けるだけなのなら
＝で繋いでしまうほうが簡単だと思います。

If .Cells(Line, 3).Value = "" Then
Maxrow = Worksheets("商品内容確認").Range("B17").End(xlDown).Row + 1
Worksheets("商品内容確認").Range("B" & Maxrow).value=Cells(Line, 1).value
End If

とかでしょうか？
試していないため、合っているかどうかは分かりませんが…