6

これは簡単なはずですが、苦労しています。セル A3 から E3 をコピーして、別のワークシートの次の空の行に貼り付けたいと思います。以前、このコードを長いコード文字列で使用したことがありますが、微調整する必要があり、今回は機能しません。以下のコードを実行すると、「アプリケーション定義またはオブジェクト定義のエラー」が発生します。すべての助けに感謝します。

Private Sub CommandButton1_Click()
Dim lastrow As Long

lastrow = Range("A65536").End(xlUp).row
   Range("A3:E3").Copy Destination:=Sheets("Summary Info").Range("A:A" & lastrow)
End Sub
4

4 に答える 4

3

以下はうまく機能するコードですが<=11、シート「計算機」で条件が満たされるたびに、シート「最終」で値が重複します

カーソルが次の空白セルに移動し、値がリストのように加算され続けるように、コードを変更することを親切にサポートしてください。

Dim i As Integer
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Calculator")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Final")

For i = 2 To ws1.Range("A65536").End(xlUp).Row

    If ws1.Cells(i, 4) <= 11 Then

        ws2.Cells(i, 1).Value = Left(Worksheets("Calculator").Cells(i, 1).Value, Len(Worksheets("Calculator").Cells(i, 1).Value) - 0)
        ws2.Cells(i, 2) = Application.VLookup(Cells(i, 1), Worksheets("Calculator").Columns("A:D"), 4, False)
        ws2.Cells(i, 3) = Application.VLookup(Cells(i, 1), Worksheets("Calculator").Columns("A:E"), 5, False)
        ws2.Cells(i, 4) = Application.VLookup(Cells(i, 1), Worksheets("Calculator").Columns("A:B"), 2, False)
        ws2.Cells(i, 5) = Application.VLookup(Cells(i, 1), Worksheets("Calculator").Columns("A:C"), 3, False)

    End If
Next i
于 2014-12-11T16:04:19.593 に答える
3

これを試すこともできます

Private Sub CommandButton1_Click()

Sheets("Sheet1").Range("A3:E3").Copy

Dim lastrow As Long
lastrow = Range("A65536").End(xlUp).Row

Sheets("Summary Info").Activate
Cells(lastrow + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

End Sub
于 2013-07-31T17:05:07.997 に答える