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

[guylrb33]

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,

[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