Copy certain cells to a specific place in a new wo

Question

I want to copy certain cells (for, if then condition) to an other sheet. I got great help with my code and it smoothly runs through the lines so far, but still it doesn't do exactly what I want.

I want to look for the value 848 in column A, if there is 848 in a certain row X, I want to copy the content of the following cells: XA, XN, XO, XAM, AH, XP XE and XF to the other worksheet. But: the columns do not remain the same. They change from one to the other workbook like:

Copy value in the column X in “source” --> Column Y in “target” A --> A, N-->B, O-->C, AM -->D, AH -->G, P-->I, E-->J, F-->K

After checking and copy pasting all the needed cells of rows containing 848 in column A, we do the same for the rows containing 618 in column A.

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

As I said, the code in general works properly, it's just that I don't get the right values to the cell I want them to. Any ideas? Thanks a lot!

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

Updated Code:

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

The problem exists here:

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

where are you defining a specific range to copy and specific place to paste.

Since you want to copy certain columns in one sheet to different columns in your other sheet, you'll need to specify each one separately. See my example below. I didn't do each iteration, but you can just copy the code I wrote and adjust for each:

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

If it's not clear, replace the code where I stated the problem was with the code I provided as a solution.