Copying selected cells from multiple rows and columns from worksheet to worksheet

[janlindgren]

Hi!

So. I have this huge excel-file with many differet worksheets. What I want to be able to do is select several rows in column B (and which rows are selected varies from time to time - sometimes rows 4-5 another time perhaps 140-250 or 31-357) in Worksheet1 and then copy the information in the selected rows from column B, C and E to Worksheet2 where they end up in column A, B and C on the first row where there is no information.

Oh, and if the information in for instance row 149 in the 140-250 example above already exists in Workheet2 then that information should not be copied.

Is this doable? If so - how?

[StevenM]

Backup your data.
Place code in a standard module.
Select rows to be copied.
Run: CopyBCE2Sheet2ABC

Function DoesRowAlreadyExistInSheet2(vColA As Variant, vColB As Variant, vColC As Variant) As Boolean
    Dim rg As Range, rgCell As Range, sAddress As String
    With Worksheets(2)
        Set rg = .Range("A:A")
        Set rgCell = rg.Find(What:=vColA, _
                           LookIn:=xlValues, _
                           Lookat:=xlWhole, _
                           SearchOrder:=xlByRows, _
                           SearchDirection:=xlNext, _
                           MatchCase:=True)
        If Not rgCell Is Nothing Then
            sAddress = rgCell.Address
            Do
                If .Cells(rgCell.Row, "B") = vColB _
                And .Cells(rgCell.Row, "C") = vColC Then
                    DoesRowAlreadyExistInSheet2 = True
                    Exit Function
                End If
                Set rgCell = rg.FindNext(rgCell)
            Loop While Not rgCell Is Nothing And sAddress <> rgCell.Address
        End If
    End With
End Function

Sub CopyBCE2Sheet2ABC()
    Dim ws2 As Worksheet, nTop As Long, nBottom As Long, nRow As Long, nNextRow As Long
    
    nTop = Selection.Row
    nBottom = Selection.Rows.Count + Selection.Row - 1
    Set ws2 = Worksheets(2)
    If ActiveSheet.Name = ws2.Name Then Exit Sub
    With ws2
        nNextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With
    For nRow = nTop To nBottom
        If Not DoesRowAlreadyExistInSheet2(Cells(nRow, "B"), Cells(nRow, "C"), Cells(nRow, "E")) Then
            ws2.Cells(nNextRow, "A") = Cells(nRow, "B")
            ws2.Cells(nNextRow, "B") = Cells(nRow, "C")
            ws2.Cells(nNextRow, "C") = Cells(nRow, "E")
            nNextRow = nNextRow + 1
        End If
    Next nRow
End Sub

[janlindgren]

It worked great! Many thanks!

Of course I forgot to mention some other paramaters that where pretty important, but I managed to figure out how to incorporate that into your code. :D