1

シート 1 (列 A) にアイテムのリストがあります。シート 1 の各項目には、追加情報 (B から F) の 5 つのセルがあります。シート 2 には、シート 1 と同じ項目がいくつかありますが、すべてではありません。シート 2 から開始し、A 列の各項目番号を見て、シート 1 で同じ番号をチェックするプログラムを作成しようとしています。同じ番号が見つかると、シート 1 から B から F のセル情報をコピーし、シート 2 (B から F) のアイテム番号の隣に配置します。

For ループを使用して、シート 2 セル A2 から開始しようとしました。変数 cSn を A2 に設定しようとした後、シート 1 をループし、cSn が見つかった場合はシート 1 からシート 2 にデータをコピーします。

プログラムが正しく実行されているかどうかを確認するために、MsgBox を追加して、プログラムが見つかったことを示しました。

プログラムは実行されているように見えますが、データをコピーしてそのままにしておくことはありません。データをコピーしてから消去し、シート 1 の最後の行のデータをシート 2 のすべての行に貼り付けているようです。このサイトや他のサイトで正しいコピー/貼り付け構文を検索しましたが、見つかりません。MS Visual Basic 7.1 を使用しています。助けてください！これが私がこれまでに持っているものです...

Sub CopyItemInfo()
    Dim cSn As String
    Sheets(1).Select
        FinalRow1 = Cells(Rows.Count, 1).End(xlUp).Row
    Sheets(2).Select
        FinalRow2 = Cells(Rows.Count, 1).End(xlUp).Row
    For x = 2 To FinalRow2
        cSn = Sheets(2).Range("A" & x)
        For y = 2 To FinalRow1
            If Sheets(1).Range("A" & y) = cSn Then MsgBox "Found One  " & cSn
                Worksheets(1).Range("B" & y).Copy Destination:=Worksheets(2).Range("B" & x)
                Worksheets(1).Range("C" & y).Copy Destination:=Worksheets(2).Range("C" & x)
                Worksheets(1).Range("D" & y).Copy Destination:=Worksheets(2).Range("D" & x)
                Worksheets(1).Range("E" & y).Copy Destination:=Worksheets(2).Range("E" & x)
                Worksheets(1).Range("F" & y).Copy Destination:=Worksheets(2).Range("F" & x)
                Application.ScreenUpdating = True
        Next y
    Next x
    Application.ScreenUpdating = True
 
End Sub
4

3 に答える 3