script to create new worksheet with values

[mmestan]

Hi, could you help me with scipt witch will create new worksheets with values on the basis of value from list1, column "M"

in list1 i've columns A to P and in column M i have values (for example:AL, BL, CL, DL, EL. I need to create new worksheets which will be named on basis of this values. To those new worsheets will be copied the rows from list1 , where is in row and column "M" value with name of worksheet.

better explain is in insetred attachement what i need to do.

thnx

[Xx7]

Hello, try clicking the button in the attached workbook.

I've created a macro that does the following:

1) Loops through Column M to get the names of the sheets
2) If sheet doesn't already exist, then a sheet is created
3) All row data from "list1" sheet is transferred to the individual sheets based on the sheet name in Column M

Sub tester()

Dim cell As Range
Dim rng As Range
Set rng = Range("M2:M20")

For Each ws In Sheets
    If Not ws.Name = ActiveSheet.Name Then
        ws.Range("A2:Q100").ClearContents
    End If
Next ws


For Each cell In rng
    If cell.Value <> "" Then
        If Not SheetExist(cell.Value) Then  'If sheet doesn't exist.. then add it

            Worksheets.Add(After:=Worksheets(Sheets.Count)).Name = _
                cell.Value
            
            Rows("1:1").Value = Sheet1.Rows("1:1").Value    'Paste title row...
        End If
    End If
Next cell


Dim r1 As Long      'Last row found on each sheet...
Dim r2 As Long      'Paste row...

Sheet1.Activate

For Each cell In rng
    If cell.Value <> "" Then
        Set ws = Sheets(cell.Value)
        
        r1 = ws.Range("A1").End(xlDown).Row
        
        If r1 > 1000000 Then
            r2 = 2
        Else
            r2 = r1 + 1
        End If
        
        ws.Rows(r2 & ":" & r2).Value = _
            Rows(cell.Row & ":" & cell.Row).Value
    End If
Next cell

MsgBox Worksheets.Count - 1 & " sheets updated!"


End Sub


'######## If Sheet exists... returns TRUE...
Function SheetExist(sh1 As String)

    For Each ws In Sheets
        If UCase(sh1) = ws.Name Then
            SheetExist = "True"
            Exit For
        Else
            SheetExist = "False"
        End If
    Next ws

End Function

[mmestan]

Xx7 .. it's great ... this scrip also update values in woksheets ... thanx