0

what I need is fairly simple but I can't for the life of me figure out how to write this in code. I tried looking around for a macro that could do this, but so far no luck.

I have a workbook with one worksheet that contains raw data and 30 or so worksheets for different customers. Each row in the raw data worksheet has the name of the customer in column I.

I need to make a macro that cuts and pastes each row to the worksheet of the respective customer, for example if I2=CustomerA, move that row to the end of sheet CustomerA. Also some customers don't have worksheets yet because they're new, so for example if I5=CustomerZ but worksheet CustomerZ not found, create it and then move the row.

4

1 回答 1

2

您真正需要做的就是设置您的 :
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
于 2013-07-01T08:41:13.500 回答