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

好的，这很好用，除了如何将sheet1中单元格的值而不是公式复制到sheet2？就像日期转移为 1900 年 1 月 0 日一样，当它需要 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

现在我在下面的部分代码中得到了 runtime-13 类型不匹配。当它出错时，单击结束，它工作正常。不想点击结束。For i = 1 To rCell.Offset(0, 23).Value

于 2011-05-08T06:18:56.590 回答