Add the sub & function and run CopyonStatus
Public Sub CopyonStatus()
Dim lastR As Long
Dim lR As Long
Dim i As Integer
Dim sName As String
Sheets("Data").Select
lastR = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastR
sName = Cells(i, 7)
lR = getLR(sName)
Sheets(sName).Cells(lR, 1).Resize(1, 6).Value = Range(Cells(i, 1), Cells(i, 6)).Value
Next i
End Sub
Public Function getLR(shtName As String) As Long
With Sheets(shtName)
getLR = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
End With
End Function
Bookmarks