Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, LastRow As Long, lRow As Long
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim iMonth As String
If Not Intersect(Range("B:B"), Target) Is Nothing Then
Set Ws1 = Worksheets("Master")
LastRow = Ws1.Range("A65536").End(xlUp).Row
'For i = 2 To LastRow
iMonth = Format(Worksheets("Master").Cells(ActiveCell.Row - 1, 2), "mmm")
On Error GoTo ErrorHandler
Set Ws2 = Worksheets(iMonth)
'find first empty row in month sheet
lRow = Ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Ws2.Cells(lRow, 1) = Ws1.Cells(ActiveCell.Row - 1, 1)
Ws2.Cells(lRow, 2) = Ws1.Cells(ActiveCell.Row - 1, 2)
'Next i
End If
Exit Sub ' Avoid error handler
ErrorHandler:
'Month sheet does not exist!
End Sub
|