Question

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

“AL”列包含多个值（验证列表），例如dog，cat，giraffe，我想为每个值自动打开新工作表并复制新工作表的相关行。（新工作表必须具有值的名称）。

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

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

如果满足条件，则将行复制到新工作表（使用VBA）

0 个答案: