Question

我想将某些单元格复制（如果条件，则为条件）到另一个单元格。我得到了很多关于我的代码的帮助，到目前为止，它顺利地贯穿了整个行，但它仍然没有完全符合我的要求。

我想在A列中查找值848，如果某行X中有848，我想复制以下单元格的内容：XA，XN，XO，XAM，AH，XP XE和XF到另一个工作表。但是：列不会保持不变。它们从一个工作簿转换到另一个工作簿，如：

复制“来源”中的第X列中的值 - ＆gt; “目标”中的Y列 A - ＆gt; A，N - > B，O - > C，AM - > D，AH - ＆gt; G，P - ＆gt; I，E - > J，F - ＆gt; K

检查并复制粘贴A列中包含848的所有行所需的单元格后，我们对A列中包含618的行执行相同操作。

A - ＆gt; N - > B O - > C AM - > D T - ＆gt; G P - ＆gt; I E - ＆gt; J F - ＆gt; K

正如我所说，代码一般都能正常运行，只是因为我没有为我想要的单元格获得正确的值。有任何想法吗？非常感谢！

Sub CopyToNewBook()

    On Error Resume Next

    Dim wbSrc As Workbook: Set wbSrc = Workbooks("invoices_eCMS.xlsx")
    Dim wbDest As Workbook: Set wbDest = Workbooks("destination.xlsx")

    If wbSrc Is Nothing Or wbDest Is Nothing Then
         MsgBox "Please open both workbooks required"
         Exit Sub
    End If

    On Error GoTo 0

    Dim SearchValues() As String: SearchValues = Split("848,618", ",")

    Dim wsSrc As Worksheet: Set wsSrc = wbSrc.Sheets("Data exAlps")
    Dim wsDest As Worksheet: Set wsDest = wbDest.Sheets("Sheet1")

    Dim LastRow As Long, i As Long, j As Long, z As Long: z = 63976

    With wsSrc
        LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        For j = 0 To UBound(SearchValues)
            For i = 2 To LastRow
                If .Cells(i, 1).Value = SearchValues(j) Then

                    .Range(.Cells(i, 1), .Cells(i, 14)).Copy
                    '.Cells(i, 1).Copy
                    wsDest.Range("A" & z).PasteSpecial xlPasteValues
                    z = z + 1
                    ', .Cells(i, 14)).Copy
                End If
            Next i
        Next j
    End With
End Sub

更新代码：

Sub CopyToNewBook()

    On Error Resume Next

    Dim wbSrc As Workbook: Set wbSrc = Workbooks("invoices_eCMS.xlsx")
    Dim wbDest As Workbook: Set wbDest = Workbooks("destination.xlsx")

    If wbSrc Is Nothing Or wbDest Is Nothing Then
         MsgBox "Please open both workbooks required"
         Exit Sub
    End If

    On Error GoTo 0

    Dim SearchValues() As String: SearchValues = Split("848,618", ",")

    Dim wsSrc As Worksheet: Set wsSrc = wbSrc.Sheets("Data exAlps")
    Dim wsDest As Worksheet: Set wsDest = wbDest.Sheets("Sheet1")

    Dim LastRow As Long, i As Long, j As Long, z As Long: z = 63976

    With wsSrc
        LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        For j = 0 To UBound(SearchValues)
            For i = 2 To LastRow
                If .Cells(i, 1).Value = SearchValues(j) Then

                    wsDest.Range("A" & z).Value = .Range("A" & i).Value
                    wsDest.Range("B" & z).Value = .Range("N" & i).Value
                    wsDest.Range("C" & z).Value = .Range("O" & i).Value
                    wsDest.Range("D" & z).Value = .Range("AM" & i).Value
                    wsDest.Range("G" & z).Value = .Range("AH" & i).Value
                    wsDest.Range("I" & i).Value = .Range("P" & z).Value
                    wsDest.Range("J" & i).Value = .Range("E" & z).Value
                    wsDest.Range("K" & i).Value = .Range("F" & z).Value
                    z = z + 1
                    ', .Cells(i, 14)).Copy
                End If
            Next i
        Next j
    End With
End Sub

Answer 1

这里存在问题：

.Range(.Cells(i, 1), .Cells(i, 14)).Copy
wsDest.Range("A" & z).PasteSpecial xlPasteValues

您在哪里定义要复制的特定范围以及要粘贴的特定位置。

由于您要将一个工作表中的某些列复制到另一个工作表中的不同列，因此您需要单独指定每个列。请参阅下面的示例。我没有做每次迭代，但你可以复制我写的代码并为每个代码进行调整：

wsDest.Range("A" & z).Value = .Range("A" & i).Value
wsDest.Range("B" & z).Value = .Range("N" & i).Value
wsDest.Range("C" & z).Value = .Range("O" & i).Value
'... and so on for each cell that needs to be copied

如果不清楚，请将我说明问题的代码替换为我提供的代码作为解决方案。

使用For，If，Then条件

1 个答案: