有条件的复制粘贴excel vba答案

【问题标题】：Conditional copy and paste excel vba有条件的复制粘贴excel vba
【发布时间】：2023-03-18 22:54:01
【问题描述】：

我正在尝试从与另一个工作簿中的范围匹配的工作表中的单元格中复制和粘贴某个值。代码运行良好，没有给出任何运行时错误，但不会粘贴到其他工作簿中声明的范围内。代码如下

Sub ConditionalCopy()
    Dim dest As Worksheet
    
    Set dest = ActiveWorkbook.Worksheets("VCP Plan")
    
    Dim rng As Range, cell As Range
    Set rng = Range("D:D")
    
    Dim OpenWorkBook As Variant
    OpenWorkBook = Application.GetOpenFilename("Excel Files (*.xlsx* (*.xlsx*),")
    
    If OpenWorkBook <> False Then
        Workbooks.Open (OpenWorkBook)
    End If
    For Each cell In rng
        If cell.Value = "26ASA00015D007" Then
            cell.Offset(0, 3).Copy Destination:=dest.Range("E3")
        End If
    Next cell            
End Sub

【问题讨论】：

标签： excel vba

【解决方案1】：

从您的描述和代码中不清楚您要比较和复制哪个工作簿/工作表，以及要复制到哪个工作簿/工作表。

你需要更具体

我猜到了你想要做什么。如果我弄错了，只需调整参考以适合

类似

Sub ConditionalCopy()
    Dim wbSource as Workbook
    Dim wsSource as Worksheet
    Dim rSource as Range
    Dim wbDest as Workbook
    Dim wsDest as Worksheet
    Dim rDest as Range

    Set wbDest = ActiveWorkbook ' Are you sure?
    Set wsDest = wbDest.Worksheets("VCP Plan")
    Set rDest = ws.Range("E3")

    Dim OpenWorkBook As Variant
    OpenWorkBook = Application.GetOpenFilename("Excel Files (*.xlsx* (*.xlsx*),")
    
    If OpenWorkBook <> False Then
        Set wbSource = Workbooks.Open(OpenWorkBook) 
    Else
        Exit Sub
    End If

    Set wsSource = wbSource.Worksheets("NameOfSourceSheet")

    Dim cell As Range
    With wsSource
        ' Column D from row 1 to last used row
        Set rSource = .Range(.Cells(1, 4), .Cells(.Rows.Count, 4).End(xlUp))
    End With
    

    For Each cell In rSource
        If cell.Value = "26ASA00015D007" Then
            cell.Offset(0, 3).Copy Destination:=rDest
            ' You probably don't want to overwrite each time, so
            Set rDest = rDest.Offset(1, 0)
        End If
    Next cell            
End Sub

【讨论】：