代码工作得很好，除了需要设置值而不是公式

发布于 2024-11-05 21:41:45 字数 687 浏览 0 评论 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 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？就像日期传输为 1/0/1900，而实际上需要是 5/5/2011

原文

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

Ok this works great except how do I copy the values not formulas of cells in sheet1 to sheet2? Like a date transfers as 1/0/1900, when it needs to be 5/5/2011

分享到QQ

分享到微博

如果你对这篇内容有疑问，欢迎到本站社区发帖提问参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

发布评论

需要登录才能够评论，你可以免费注册一个本站的账号。

山有枢 2024-11-12 21:41:45

您需要使用 PasteSpecial 方法，并将 xlPasteValues 作为 PasteType。像这样的东西：

Sheet2.Cells(1,1).PasteSpecial xlPasteType.xlPasteValues

You need to use the PasteSpecial method with the xlPasteValues as the PasteType. Something like:

Sheet2.Cells(1,1).PasteSpecial xlPasteType.xlPasteValues

回复收藏 0 原文

凉栀 2024-11-12 21:41:45

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

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

Now I'm getting a runtime-13 type mismatch on below part of the code. When it errors, click end and it works fine. Don't want to have to click end.
For i = 1 To rCell.Offset(0, 23).Value

回复收藏 0 原文

~没有更多了~