Link Data

Sub MoveDataFromMasterToValueBasedSheet()

Dim sMasterSheet As String 'name of the master sheet
Dim sTempSheet As String 'name of a temp sheet for purpose of working
Dim iBasedOnColumn As Integer 'column number based on which sheets are to be generated
Dim lMaxUniqueValueCount As Long 'number of unique items on which sheets are to be generated
Dim lItemCount As Long ' unique items being counted
Dim sUniqueValue As String ' the value for which the sheet is being generated

    sMasterSheet = "Master"
    sTempSheet = "tempsheet"
    iBasedOnColumn = 1
    
    On Error Resume Next
        Sheets(sTempSheet).Delete
    On Error GoTo 0
    
    Sheets.Add
    ActiveSheet.Name = sTempSheet
    
    Sheets(sMasterSheet).Select
    
    If ActiveSheet.AutoFilterMode Then
        Cells.Select
        
        On Error Resume Next
        
        ActiveSheet.ShowAllData
        
        On Error GoTo 0
    
    End If
    
    Columns(iBasedOnColumn).Select
    Selection.Copy
    
    Sheets(sTempSheet).Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    If (Cells(1, 1) = "") Then
        LastRow = Cells(1, 1).End(xlDown).Row
        
        If LastRow <> Rows.Count Then
            Range("A1:A" & LastRow - 1).Select
            Selection.Delete Shift:=xlUp
        End If
    
    End If
    
    Columns("A:A").Select
    Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True
    
    Columns("A:A").Delete
    
    Cells.Select
    Selection.Sort _
                Key1:=Range("A2"), Order1:=xlAscending, DataOption1:=xlSortNormal, _
                Header:=xlYes, OrderCustom:=1, _
                MatchCase:=False, Orientation:=xlTopToBottom
    
    lMaxUniqueValueCount = Cells(Rows.Count, 1).End(xlUp).Row
    
    For lItemCount = 2 To lMaxUniqueValueCount
    
        sUniqueValue = Sheets(sTempSheet).Range("A" & lItemCount)
        
        If sUniqueValue <> "" Then
        
            On Error Resume Next
                Sheets(sUniqueValue).Delete
            On Error GoTo 0
            
            Sheets.Add
            ActiveSheet.Name = sUniqueValue
            
            Sheets(sMasterSheet).Select
            Cells.Select
            
            If ActiveSheet.AutoFilterMode = False Then
                Selection.AutoFilter
            End If
            
            Selection.AutoFilter Field:=iBasedOnColumn, Criteria1:="=" & sUniqueValue, Operator:=xlAnd, Criteria2:="<>"
            
            LastRow = Cells(Rows.Count, iBasedOnColumn).End(xlUp).Row
            
            'in case you want the headers to be pasted also
            Rows("1:" & LastRow).Copy
            
            ' in case you dont want the headers to be pasted
            ' Rows("2:" & lastrow).Copy
            
            Sheets(sUniqueValue).Range("A1").PasteSpecial
        
        End If
    
    Next
    
    Sheets(sTempSheet).Delete
    
    Sheets(sMasterSheet).Select
    If ActiveSheet.AutoFilterMode Then
        Cells.Select
        ActiveSheet.ShowAllData
    End If

End Sub