from mastersheet to other sheets (find the last blank raw)

[guylrb33]

[COLOR=rgba(0, 0, 0, 0.87)]Hi,
How can I change the code to move the data from the master sheet to the other sheets (and after the operation) to the last row it identifies as blank in each sheet
thanks in advance,

[/COLOR]

[paulked]

Hi and welcome to the forum.

That code copies the relevant data to the sheets but it doesn't clear old 'messed up' data. If that's what you want (but it's not that clear what you want), then add the line in red to the code:

    For i = 2 To UBound(myarr)
        ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
        If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
            Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
        Else
            Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
        End If
        Sheets(myarr(i) & "").ClearContents
        ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
    Next

[guylrb33]

hi thanks for the help

I will make it clear what I want. I don't want to erase old data. the data will be added to existing data in each sheets. for example, in the powerpiont sheet the last column used is 16 so the code will put the data in line 18 from the mastersheet. in access sheet the last columns used is 13 so the code will put data in line 15.
thanks

Hi and welcome to the forum.

That code copies the relevant data to the sheets but it doesn't clear old 'messed up' data. If that's what you want (but it's not that clear what you want), then add the line in red to the code:

    For i = 2 To UBound(myarr)
        ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
        If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
            Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
        Else
            Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
        End If
        Sheets(myarr(i) & "").ClearContents
        ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
    Next

[paulked]

Sub doll()
    Dim lr As Long, lrA As Long, lrE As Long, lrP As Long, i As Long
    Dim sh As Worksheet, shA As Worksheet, shE As Worksheet, shP As Worksheet
    
    Set sh = Sheets("master")
    Set shA = Sheets("access")
    Set shE = Sheets("excel")
    Set shP = Sheets("powerpoint")
    
    
    Application.ScreenUpdating = False
    
    lr = sh.Cells(Rows.Count, 1).End(3).Row
    lrA = shA.Cells(Rows.Count, 1).End(3).Row + 3
    lrE = shE.Cells(Rows.Count, 1).End(3).Row + 3
    lrP = shP.Cells(Rows.Count, 1).End(3).Row + 3
    
    For i = 2 To lr
        If sh.Cells(i, 1) = "access" Then
            sh.Rows(i).Copy shA.Cells(lrA, 1)
            lrA = lrA + 1
        End If
        If sh.Cells(i, 1) = "excel" Then
            sh.Rows(i).Copy shE.Cells(lrE, 1)
            lrE = lrE + 1
        End If
        If sh.Cells(i, 1) = "powerpoint" Then
            sh.Rows(i).Copy shP.Cells(lrP, 1)
            lrP = lrP + 1
        End If
    Next
End Sub