Sub Button5_Click() Dim myDestSheet As Worksheet Dim destRow As Long Dim i As Integer total As Integer With ThisWorkbook [FONT=Verdana]Do [/FONT]While i < 23total = 13 + i If sheet16.Cells(" & total & ", 2) = "P" Then On Error Resume Next Set myDestSheet = Worksheets(Cells(" & total & ", 1).Value) destRow = myDestSheet.Cells(Rows.Count, "a").End(xlUp).Row + 1 Application.EnableEvents = False With myDestSheet .Cells(destRow, 1) = Date .Cells(destRow, 2) = sheet16.Cells(" & total & ", 2).Value .Cells(destRow, 3) = Cells(6, 2).Value .Cells(destRow, 4) = Cells(7, 2).Value .Cells(destRow, 5) = Cells(8, 2).Value .Cells(destRow, 6) = Cells(9, 2).Value .Cells(destRow, 7) = Cells(10, 2).Value End With Application.EnableEvents = True End Ifloop End WithEnd Sub