当指定列中的单元格更改时，复制表的一行

Question

I'm trying to copy the row in a table when a cell in a specified column has data inserted then paste this row into another sheet.

The table starts at cell A3 being the first header to the table and it is 9 columns long, there will be an endless amount of rows.

The column to monitor for change is column 8, named "Date Complete". The information entered should always be a date, format "dd mmm".

The row needs to be copied onto a sheet with the same name as the date entered into column 8 which may not exist before the date is entered.

Also before the copying is done I would like a text box to enter notes into the corresponding cell in column 9, named "Notes".

Private Sub Worksheet_change(ByVal Target As Range)

   Const lngdatecomplete As Long = 8

   Dim wks As Worksheet

   Dim lngNextAvailableRow As Long

   If Target.Areas.Count = 1 And Target.Cells.Count = 1 Then

      If Not Intersect(Target, Columns(lngdatecomplete)) Is Nothing Then                            

         On Error Resume Next
         Set wks = ThisWorkbook.Worksheets(Target.Value)
         On Error GoTo 0

         If wks Is Nothing Then

            lngNextAvailableRow = wks.Range("a1").CurrentRegion.Rows.Count + 1
            ActiveSheet.Range(Cells(Target.Row, 2), Cells(Target.Row, 8)).copy _
             wks.Range("A" & lngNextAvailableRow).PasteSpecial

         ElseIf Not wks Is Nothing Then

            Dim ShtName$

            Sheets.Add after:=Sheets(Sheets.Count)

            ShtName = Format(Date, "dd mmm")

            Sheets(Sheets.Count).Name = ShtName

            Sheets(ShtName).Visible = True

            lngNextAvailableRow = wks.Range("a1").CurrentRegion.Rows.Count + 1
            ActiveSheet.Range(Cells(Target.Row, 2), Cells(Target.Row, 8)).copy _
             wks.Range("A" & lngNextAvailableRow).PasteSpecial

         End If
      End If
   End If
End Sub

Answer 1

The following seems pretty robust and will accept multiple values pasted into column H. I would advise setting a breakpoint on the Application.EnableEvents = False code line and typing a date into column H. Once you arrive at the breakpoint, you can step through each line with the F8 key.

Private Sub Worksheet_change(ByVal Target As Range)
    Const lDATECMPLT As Long = 8

    If Not Intersect(Target, Columns(lDATECMPLT)) Is Nothing Then
        On Error GoTo bm_Safe_Exit
        'Application.ScreenUpdating = False
        Application.EnableEvents = False
        Dim trgt As Range
        For Each trgt In Intersect(Target, Columns(lDATECMPLT))
            If trgt.Row > 3 And IsDate(trgt) Then
                trgt.NumberFormat = "dd mmm"
                On Error GoTo bm_Need_WS
                With Worksheets(trgt.Text)
                    On Error GoTo bm_Safe_Exit
                    trgt.Resize(1, 7).Offset(0, -6).Copy _
                      Destination:=.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                    'optional mark the row copied
                    'With trgt.Resize(1, 7).Offset(0, -6).Font
                    '    .Strikethrough = True
                    '    .Color = RGB(120, 120, 120)
                    'End With
                End With
            End If
        Next trgt
    End If
    GoTo bm_Safe_Exit

bm_Need_WS:
    On Error GoTo 0
    With Worksheets.Add(after:=Sheets(Sheets.Count))
        .Name = trgt.Text
        .Visible = True
        .Cells(1, 1).Resize(1, 7) = Me.Cells(3, 2).Resize(1, 7).Value2
        With ActiveWindow
            .SplitColumn = 0
            .SplitRow = 1
            .FreezePanes = True
            .Zoom = 80
        End With
    End With
    Resume

bm_Safe_Exit:
    Application.EnableEvents = True
    Me.Activate
    Application.ScreenUpdating = True
End Sub

I left some extras like copying the headers from the original worksheet into the new worksheet, freezing row 1 on the new worksheet, zooming the new worksheet, etc. Delete or adjust these these if you do not find them helpful.

When you have made all adjustments to the code, uncomment the 'Application.ScreenUpdating = False code line to avoid screen flashes.