Split data from Master Sheet to existing worksheets and overwrite data

**vmwest** · 03-21-2013, 11:07 AM

Hi All,

I'm new to macros and was hoping someone here could help me out. I'm currently using the code (found it on one of these forums) below to split data based on criteria in column A from a master workseet onto several existing worksheets (One tab for each salesman). This code works great but adds the data to the first non-blank row in the existing sheets. I would like for it to overwrite any data as this workbook is updated monthly and should only reflect current month activity. Any help would be greatly appreciated!!

Sub Split() 
    Dim rng As Range 
    Dim rng1 As Range 
    Dim vrb As Boolean 
    Dim sht As Worksheet 
    Set rng = Sheets("Total").Range("A4") 
    Set rng1 = Sheets("Total").Range("A4:H4") 
    vrb = False 
    Do While rng <> "" 
        For Each sht In Worksheets 
            If sht.name = Left(rng.Value, 31) Then 
                sht.Select 
                Range("A2").Select 
                Do While Selection <> "" 
                    ActiveCell.Offset(1, 0).Activate 
                Loop 
                rng1.Copy ActiveCell 
                ActiveCell.Offset(1, 0).Activate 
                Set rng1 = rng1.Offset(1, 0) 
                Set rng = rng.Offset(1, 0) 
                vrb = True 
            End If 
        Next sht 
        If vrb = False Then 
            Sheets.Add after:=Sheets(Sheets.Count) 
            ActiveSheet.name = Left(rng.Value, 31) 
            Sheets("Total").Range("A3:H3").Copy ActiveSheet.Range("A1") 
            Range("A2").Select 
            Do While Selection <> "" 
                ActiveCell.Offset(1, 0).Activate 
            Loop 
            rng1.Copy ActiveCell 
            Set rng1 = rng1.Offset(1, 0) 
            Set rng = rng.Offset(1, 0) 
        End If 
        vrb = False 
    Loop 
End Sub

**AB33** · 03-21-2013, 11:39 AM

Your code has lots of activate and select. These will slow down the code, specially if the data involves are large.
Try this code. It does the same. I assumed that you want to copy from A4 H4 and headings are in A1-H1

Sub craetenames1()
Dim i As Long, LR As Long, NR As Long, nome As String, sh As Worksheet, ws As Worksheet

    Application.ScreenUpdating = False
    Application.DisplayAlerts = 0
    On Error Resume Next
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Total" Then
            ws.Cells.ClearContents
        End If
    Next
With Sheets("Total")
    LR = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
    For i = 4 To LR
         If Trim(UCase(.Range("A" & i).Value)) <> vbNullString Then
             nome = Trim(UCase((.Range("A" & i).Value)))
             If Not Evaluate("ISREF('" & nome & "'!A1)") Then
             Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = nome
             End If
             .Range("A1:H1").Copy Worksheets(nome).Range("A1")
            .Rows(i).Copy
             Worksheets(nome).Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial xlValues
             Worksheets(nome).Columns.AutoFit
        End If
    Next i
End With
    Application.CutCopyMode = 0
    
     For Each ws In ThisWorkbook.Worksheets
            With ws
                Application.DisplayAlerts = 0
                If .Name Like "Sheet*" Then ws.Delete
            End With
        Next
        Application.DisplayAlerts = 1
        Application.ScreenUpdating = True
 
End Sub

**vmwest** · 03-21-2013, 02:18 PM

This works! My headers are in A1:H1 but I'd like to copy from A2:H2 if possible. Also, is there a way to add a subtotal for column H? Thanks so much!!

**vmwest** · 03-21-2013, 02:48 PM

Ok, I changed i = 2 and that updated the copy range to A2:H2 as desired. But I just ran into a new issue. I have other sheets (besides the master & existing salesman tabs) in this workbook that were cleared of data when I ran the macro. These are cumulative summary sheets that shouldn't be affected by the macro. I noticed at the end of the code there was Then ws. Delete. Is this what's causing that?

**arlu1201** · 03-21-2013, 02:46 PM

vmwest,

Welcome to the forum.

I have added code tags to your post. As per forum rule 3, you need to use them whenever you put any code in your post. Please add them in future. If you need more information on how to use them, check my signature below this post.

**AB33** · 03-21-2013, 03:52 PM

No, sometimes the name is not valid one, so instead of showing an error, I let it go and the code will create blank sheet1,2 and so on if the cell value is not valid name.
You need to change this line of the code

        If ws.Name <> "Total" Then

 If ws.Name <> "Total" and ws.Name <> "youtsheetname to bexclude" and ws.Name <> "same"

Then

So, add to the above the name of the sheet which you wish to exclude, but you can delete that line if you do not want to

Then ws. Delete

' the whole line should be deleted

**vmwest** · 03-21-2013, 05:21 PM

What a beautiful thing! Works perfect! Thank You!!

**AB33** · 03-21-2013, 05:36 PM

Vmwest,
You are welcome!
If you are happy with the solution provided, please close this thread.
Go in to the top right -hand of this page, choose "Thread Tools" from the menu, then solved from the drop down menu