1 
Private Sub CommandButton1_Click()
Dim rCell As Range
Dim i As Long
Dim rNext As Range
'loop through the cells in column A of the source sheet
For Each rCell In Sheet1.Range("A3:U25")
    'loop as many times as the value in column U of the source sheet
    For i = 1 To rCell.Offset(0, 22).Value
        'find the next empty cell to write to in the dest sheet
        Set rNext = Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Offset(1, 0)
        'copy A and B from source to the dest sheet
        rCell.Resize(1, 22).Copy rNext.Resize(1, 1)

        Next i
    Next rCell
End Sub

シート1のセルの数式ではなく値をシート2にコピーする方法を除いて、これはうまく機能しますか？日付が1/0/1900として転送されるように、2011年5月5日である必要がある場合

4

2 に答える 2

1

xlPasteValues を PasteType として PasteSpecial メソッドを使用する必要があります。何かのようなもの：

Sheet2.Cells(1,1).PasteSpecial xlPasteType.xlPasteValues
于 2011-05-06T22:51:00.570 に答える
0 
Private Sub CommandButton1_Click()
Dim rCell As Range
Dim i As Long
Dim rNext As Range
'loop through the cells in column A of the source sheet
For Each rCell In Sheet4.Range("A3:U25")
    'loop as many times as the value in column U of the source sheet
    For i = 1 To rCell.Offset(0, 23).Value
        'find the next empty cell to write to in the dest sheet
        Set rNext = Sheet12.Cells(Sheet12.Rows.Count, 1).End(xlUp).Offset(1, 0)
        'copy A and B from source to the dest sheet
        rCell.Resize(1, 23).Copy
        rNext.Resize(1, 1).PasteSpecial (xlPasteValues)
    Next i
Next rCell
End Sub

現在、コードの下の部分でランタイム 13 型の不一致が発生しています。エラーが発生した場合は、終了をクリックすると正常に動作します。終了をクリックする必要はありません。i = 1 の場合 rCell.Offset(0, 23).Value へ

于 2011-05-08T06:18:56.590 に答える