时间戳

首页 > 解决方案 > 遍历表格并剪切并粘贴到另一张纸上

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

问题描述

我是一个完全的初学者，感谢我能得到的任何帮助。

Sheet1 列出了 30 个市场。市场 1 市场 2 。. 市场30

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

Sheet2 有我所有的原始数据。

循环通过 Sheet2 我需要将每一行移动到相应的市场。市场 ID 在 B 列中。

1×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

谢谢

标签： excelvbaloops

解决方案

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

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

推荐阅读