CODEWITHSUNDEEP
excelcopy-pastevba
Doug Gilmer
Doug Gilmer

Reputation: 1

need to paste info in the next blank space

With this code it will copy the data and paste it on the appropriate corresponding tab that the name belongs to, but when I run it again for the next set of data it over write the last data. I am not sure how to add the verbiage to paste to the next empty row

    Dim c As Range, namesRng As Range
    Dim name As Variant

    With Worksheets("DRIVERS") '<--| reference "DRIVERS" worskheet
        Set namesRng = .Range("A2", .Cells(.Rows.Count, "a").End(xlUp)) '<--| set the range of "drivers" in column "a" starting from row 4 down to last not empty row
    End With

    With CreateObject("Scripting.Dictionary") '<--| instance a 'Dictionary' object
        For Each c In namesRng.SpecialCells(xlCellTypeConstants, xlTextValues) '<--| loop through "drivers" range cells with text content only
            .Item(c.Value) = c.Value '<--| build the unique list of names using dictionary key
        Next
        Set namesRng = namesRng.Resize(namesRng.Rows.Count + 1).Offset(-1) '<--| resize the range of "names" to have a "header" cell (not a name to filter on) in the first row
        For Each name In .Keys '<--| loop through dictionary keys, i.e. the unique names list
            FilterNameAndCopyToWorksheet namesRng, name '<--| filter on current name and copy to corresponding worksheet
        Next
    End With '<--| release the 'Dictionary' object
End Sub

Sub FilterNameAndCopyToWorksheet(rangeToFilter As Range, nameToFilter As Variant)
    Dim destsht As Worksheet

    Set destsht = Worksheets(nameToFilter) '<--| set the worksheet object corresponding to passed name
    With rangeToFilter
        .AutoFilter Field:=1, Criteria1:=nameToFilter
        Intersect(.Parent.UsedRange, .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow).Copy destsht.Cells(destsht.Rows.Count, "a").End(xlUp)
        .Parent.AutoFilterMode = False

    End With
End Sub

Upvotes: 0

Views: 157

Answers (1)

Sixthsense
Sixthsense

Reputation: 1975

destsht.Cells(destsht.Rows.Count, "a").End(xlUp)

In the above code Just add offset() in the end.

destsht.Cells(destsht.Rows.Count, "a").End(xlUp).Offset(1)

Upvotes: 1

Related Questions