Vba 创建行并将行添加到工作表

我对VBA编码相当陌生。我想设置一个模板，并希望创建一个查看B列的宏。然后为B中的不同输入创建新的工作表。最后，它会将值为“B1”的所有行拉入相应的工作表中

（例如，如果不清楚）B列包括值1和2。代码然后创建名为“1”和“2”的工作表。然后获取列B中包含1的所有行，并将它们放入工作表“1”，类似于值“2”

---

谢谢

这就是我移动行的原因：

Dim contract As String
Imprt = Worksheets("ImportSheet").UsedRange.Rows.Count
   Srtd = Worksheets(contract)"enter code here"
   If Srtd = 1 Then Srtd = 0
    For x = Imprt To 2 Step -1
        If Range("J" & x).Value = contract Then
            Rows(x).Cut Destination:=Worksheets(contract).Range("A" & Srtd + 1)
            Srtd = Srtd + 1
            Else:
        End If
    Next x

尝试下面的代码（代码内部的解释为注释）：

选项显式
分页（）
暗淡的光线和长的一样
作为对象的Dim Dict
变暗键作为变量
最后一排一样长
以工作表的形式显示
作为字符串的Dim ShtName
Set Dict=CreateObject（“Scripting.Dictionary”）
带有工作表（“导入表”）
'从第2行循环到最后一行，数据在列“B”中'
对于lRow=2到.Cells（.Rows.Count，“B”）.End（xlUp）.Row
'将唯一值从列B复制到字典中
如果不存在Dict.exists（.Range（“B”）和lRow.value），则
如果.Range（“B”&lRow）.value”，则指定添加.Range（“B”&lRow）.value、.Range（“B”&lRow）.value
如果结束
下一条路
'为字典中的每个唯一键创建新工作表
对于Dict中的每个键
Worksheets.Add（之后：=Sheets（Sheets.Count））.Name=Key
下一键
'循环遍历B列中的所有单元格，并将每一行复制到相关工作表中
对于lRow=.Cells（.Rows.Count，“B”）.End（xlUp）。行到2步骤-1
如果.Range（“B”和lRow）.value“”则
ShtName=.Range（“B”&lRow）.value
Set DestSht=工作表（ShtName）
LastRow=DestSht.Cells（DestSht.Rows.Count，“B”）。结束（xlUp）。行+1
.Rows（lRow）.Copy Destination:=DestSht.Range（“A”和LastRow）
.Rows（lRow）.删除xlShiftUp
如果结束
下一条路
以
端接头

it@fungrymonster“导入表”中是否有标题行（第1行）？那么这些值从第2行开始？是的，它们从第2行开始2@fungrymonster不客气，请注明答案。Y单击我答案旁边的V

Dim contract As String
Imprt = Worksheets("ImportSheet").UsedRange.Rows.Count
   Srtd = Worksheets(contract)"enter code here"
   If Srtd = 1 Then Srtd = 0
    For x = Imprt To 2 Step -1
        If Range("J" & x).Value = contract Then
            Rows(x).Cut Destination:=Worksheets(contract).Range("A" & Srtd + 1)
            Srtd = Srtd + 1
            Else:
        End If
    Next x

Option Explicit

Sub Sheet()

Dim lRow    As Long
Dim Dict    As Object
Dim Key     As Variant
Dim LastRow As Long
Dim DestSht As Worksheet
Dim ShtName As String

Set Dict = CreateObject("Scripting.Dictionary")

With Worksheets("ImportSheet")

    ' loop from row 2 until last row with data in Column "B"
    For lRow = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row          
        ' copy unique values from column B into dictionary
        If Not Dict.exists(.Range("B" & lRow).value) Then
            If .Range("B" & lRow).value <> "" Then Dict.Add .Range("B" & lRow).value, .Range("B" & lRow).value
        End If
    Next lRow

    ' create a new worksheet per unique key in Dictionary
    For Each Key In Dict
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = Key
    Next Key

    ' loop through all cells in Column B, and copy each row to relevant worksheet
    For lRow = .Cells(.Rows.Count, "B").End(xlUp).Row To 2 Step -1
        If .Range("B" & lRow).value <> "" Then
            ShtName = .Range("B" & lRow).value
            Set DestSht = Worksheets(ShtName)
            LastRow = DestSht.Cells(DestSht.Rows.Count, "B").End(xlUp).Row + 1
            .Rows(lRow).Copy Destination:=DestSht.Range("A" & LastRow)
            .Rows(lRow).Delete xlShiftUp
        End If
    Next lRow
End With

End Sub