View Single Post
 
Old 10-28-2015, 12:52 PM
jtammyg jtammyg is offline
Freshman
 
Join Date: Jun 2008
Posts: 36
Question Split main sheet into multiple sheets using VB 2010 inserting too many sheets

Hi!

I'm trying to split sheet called "Temp", into multiple sheets depending on change of column A.

My below code is adding 28 sheets which is way too many, since there is only 14 hospitals. Plus the first sheets which has other data and the temp sheet where is the actual data that gets filter.

So it has 1 sheet with hospital A, leaves one sheet blank, adds another sheet with hospital B, leaves ones blank etc.

It is also adding each of the hospitals data into the first sheet which is called "FQHCs Overall Measure Summary" and already has data in it and doesn't need to be touched.

My purpose is to add a sheet and paste there the hospital A data, add another sheet and onto that one paste hospital B data, add another sheet and paste hospital C data, etc.

Here is the code:

Code:
 Dim r As Excel.Range, r1 As Excel.Range, r2 As Excel.Range
        Dim c2 As Excel.Range
        Dim wks1 As Excel.Worksheet = xlWorkBookFQHCs.Worksheets("Sheet2")
        Dim wks2 As Excel.Worksheet

        wks1.Activate()
        wks1.Name = "Temp"
        r = wks1.Range(wks1.Range("A1"), wks1.Range("A1").End(Excel.XlDirection.xlDown))
        r1 = wks1.Range("A1").End(Excel.XlDirection.xlDown).Offset(1, 0)
        wks1.AutoFilterMode = False
        r.AdvancedFilter(Action:=Excel.XlFilterAction.xlFilterCopy, CopyToRange:=r1, Unique:=True)
        r2 = wks1.Range(r1.Offset(1, 0), r1.End(Excel.XlDirection.xlDown))
        If wks1.Name <> "Temp" Or wks1.Name <> "FQHCs Overall Measure Summary" Then
            For Each c2 In r2

                For intCount = 1 To 2
                    wks2 = xlWorkBookFQHCs.Worksheets.Add(After:=xlWorkBookFQHCs.Worksheets(intCount))
                    r.CurrentRegion.AutoFilter(Field:=1, Criteria1:=c2.Value)
                    r.CurrentRegion.Cells.SpecialCells(Excel.XlCellType.xlCellTypeVisible).Copy()

                    xlWorkBookFQHCs.Worksheets(intCount).Cells(wks1.Rows.Count, "A").End(Excel.XlDirection.xlUp).Offset(0, 0).PasteSpecial()

                    wks1.Activate()
                    'r.CurrentRegion.AutoFilter()
                    wks1.AutoFilterMode = False
                Next
            Next c2

        End If
What am I doing wrong?????

Someone please help.



Thanks a lot!

Tammy
Reply With Quote