我正在尝试根据列中单元格的值将行从主表格复制到不同的表格:

列"AL"包含多个值(验证列表),例如 dogcatgiraffe ,我想为每个值自动打开新工作表,并将相关行复制到新工作表 . (新工作表必须具有值的名称) .

此外,当添加新数据时,我需要将新行添加到正确的工作表中 .

Sub Copy_Data()
Dim r As Range, LastRow As Long, ws As Worksheet
Dim v As Variant, s As String, LastRow1 As Long
Dim src As Worksheet
Set src = Sheets("Sheet1")
LastRow = src.Cells(Cells.Rows.Count, "AL").End(xlUp).Row
'Change these to your strings to copy
s = "dog,cat,fish,giraffe"
v = Split(s, ",")
For Each r In src.Range("AL1:AL" & LastRow)
    If Not IsError(Application.Match(CStr(r.Value), v, 0)) Then
        On Error Resume Next
        Set ws = Sheets(CStr(r.Value))
        On Error GoTo 0
        If ws Is Nothing Then
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = CStr(r.Value)
            LastRow1 = Sheets(CStr(r.Value)).Cells(Cells.Rows.Count, "AL").End(xlUp).Row
            src.Rows(r.Row).Copy Sheets(CStr(r.Value)).Cells(LastRow1 + 1, 1)
            Set ws = Nothing
        Else
            LastRow1 = Sheets(CStr(r.Value)).Cells(Cells.Rows.Count, "Al").End(xlUp).Row
            src.Rows(r.Row).Copy Sheets(CStr(r.Value)).Cells(LastRow1 + 1, 1)
            Set ws = Nothing
        End If
    End If
Next r
End Sub