Question

我有一个copy-if例程，我无法找到如何粘贴值。有人可以帮忙吗？

我的例程如下：

Sub CopyRowsAcross()

Dim i As Integer

Dim ws1 As Worksheet: Set ws1 = Workbooks("Bok2.xlsx").Sheets("Ark1")

Dim ws2 As Worksheet: Set ws2 = Workbooks("Bok2.xlsx").Sheets("Ark2")

Dim ws3 As Worksheet: Set ws3 = ThisWorkbook.Sheets("Ark1")



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

If ws1.Cells(i, 1) = "Videreføres" Then ws2.Range("B1:B100")(i).Copy ws3.Range("A1:A100")(ws3.Cells(ws3.Range("A1:A100").Count, 1).End(xlUp).Row + 1)

If ws1.Cells(i, 1) = "Videreføres" Then ws2.Range("C1:C100")(i).Copy ws3.Range("B1:B100")(ws3.Cells(ws3.Range("B1:B100").Count, 1).End(xlUp).Row + 0)

If ws1.Cells(i, 1) = "Videreføres" Then ws2.Range("E1:E100")(i).Copy ws3.Range("C1:C100")(ws3.Cells(ws3.Range("C1:C100").Count, 1).End(xlUp).Row + 0)

Next i

End Sub

Answer 1

您只是粘贴了您复制的内容，而实际上您需要使用PasteSpecial函数。试着看看：

Sub CopyRowsAcross()
    Dim i As Integer
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet

    Set ws1 = Workbooks("Bok2.xlsx").Sheets("Ark1")
    Set ws2 = Workbooks("Bok2.xlsx").Sheets("Ark2")
    Set ws3 = ThisWorkbook.Sheets("Ark1")

    For i = 2 To ws1.Range("A100").End(xlUp).Row
        If ws1.Cells(i, 1) = "Videreføres" Then
            With ws2
                .Range("B1:B100")(i).Copy
                ws3.Range("A1:A100")(ws3.Cells(ws3.Range("A1:A100").Count, 1).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
                .Range("C1:C100")(i).Copy
                ws3.Range("B1:B100")(ws3.Cells(ws3.Range("B1:B100").Count, 1).End(xlUp).Row + 0).PasteSpecial Paste:=xlPasteValues
                .Range("E1:E100")(i).Copy
                ws3.Range("C1:C100")(ws3.Cells(ws3.Range("C1:C100").Count, 1).End(xlUp).Row + 0).PasteSpecial Paste:=xlPasteValues
            End With
        End If
    Next i
End Sub

在“复制代码”中粘贴特殊（值）

1 个答案: