Question

我是一个初学者，非常感谢我能提供的任何帮助。

Sheet1包含30个市场的列表。市场1 市场2 。。 Market30

我有一个遍历Sheet1并为每个市场创建新表的脚本。

Sheet2拥有我所有的原始数据。

遍历Sheet2我需要将每一行移至其相应的市场。市场ID在B列中。

1-by-1我可以使用下面的代码来执行此操作，但是如何将其放入循环中？我想遍历Sheet1，并针对每个市场ID，使用该输入作为变量来搜索Sheet2，并将整行移动到其相应的市场表。

Sub Market1()
Dim LR As Long, i As Long
With Sheets("Sheet2")
LR = .Range("B" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If .Range("B" & i).Value = "Market1" Then .Rows(i).Copy Destination:=Sheets("Market1").Range("A" & Rows.Count).End(xlUp).Offset(1)
Next i
End With
End Sub


Sub Market2()
Dim LR As Long, i As Long
With Sheets("Sheet2")
LR = .Range("B" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If .Range("B" & i).Value = "Market2" Then .Rows(i).Copy Destination:=Sheets("Market2").Range("A" & Rows.Count).End(xlUp).Offset(1)
Next i
End With
End Sub

谢谢

Answer 1

我认为这应该做您想要的。唯一棘手的事情是如果已经有了工作表名称，则添加工作表。我添加了第二个宏来检查它并创建（如果找不到）。根据您的代码（这是一个很好的示例），我认为这应该对您有用。

Sub MarketAny()
Dim LR As Long, i As Long
Dim ws As Worksheet, shName As String


Set ws = Sheets("Sheet2")

LR = ws.Range("B" & ws.Rows.Count).End(xlUp).Row

    For i = 1 To LR

    shName = ws.Range("B" & i).Value
    Call SheetCheck(shName) ' needed to ensure that you don't create a duplicate name

        ws.Rows(i).Copy Destination:=Sheets(shName).Range("A" & Rows.Count).End(xlUp).Offset(1)
Next i


End Sub

Private Sub SheetCheck(nameofSheet As String)
Dim ws As Worksheet

For Each ws In ThisWorkbook.Sheets
     If ws.Name = nameofSheet Then Exit Sub

Next ws

'Creates new sheet
Set ws = Sheets.Add
ws.Name = nameofSheet

End Sub

遍历表格并剪切粘贴到另一张纸上

1 个答案: