根据单元格值将行移动到现有的/新的工作表

我需要的是相当简单，但我不能为我的生活弄清楚如何写在代码中。 我试图寻找一个macros，可以做到这一点，但迄今没有运气。

我有一个工作簿，其中包含原始数据和30个左右的工作表，为不同的客户。 原始数据工作表中的每一行都有第一列中的客户名称。

我需要制作一个macros，将每行剪切并粘贴到相应客户的工作表中，例如，如果I2 = CustomerA，则将该行移动到表CustomerA的末尾。 还有些客户还没有工作表，因为他们是新的，所以例如，如果I5 = CustomerZ，但没有find工作表CustomerZ，创build它，然后移动该行。

Answer 1

你真的必须做的是设置你的：
sh33tName所以它匹配您的主工作表
custNameColumn ，使其与您的列名称与客户名称匹配
stRow客户名称开始的行

 Option Explicit Sub Fr33M4cro() Dim sh33tName As String Dim custNameColumn As String Dim i As Long Dim stRow As Long Dim customer As String Dim ws As Worksheet Dim sheetExist As Boolean Dim sh As Worksheet sh33tName = "Sheet1" custNameColumn = "I" stRow = 2 Set sh = Sheets(sh33tName) For i = stRow To sh.Range(custNameColumn & Rows.Count).End(xlUp).Row customer = sh.Range(custNameColumn & i).Value For Each ws In ThisWorkbook.Sheets If StrComp(ws.Name, customer, vbTextCompare) = 0 Then sheetExist = True Exit For End If Next If sheetExist Then CopyRow i, sh, ws, custNameColumn Else InsertSheet customer Set ws = Sheets(Worksheets.Count) CopyRow i, sh, ws, custNameColumn End If Reset sheetExist Next i End Sub Private Sub CopyRow(i As Long, ByRef sh As Worksheet, ByRef ws As Worksheet, custNameColumn As String) Dim wsRow As Long wsRow = ws.Range(custNameColumn & Rows.Count).End(xlUp).Row + 1 sh.Rows(i & ":" & i).Copy ws.Rows(wsRow & ":" & wsRow).PasteSpecial _ Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False End Sub Private Sub Reset(ByRef x As Boolean) x = False End Sub Private Sub InsertSheet(shName As String) Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = shName End Sub