Creating new worksheets in workbook

[shaz0503]

Hi all

I have a workbook I have been playing around with for a while..

I have used code and assistance from you in sorting this, however I can't seem to get it to run correctly.

I would prefer not to have 'hard code' if possible as the end users are not familiar with code.

I have all macros working as far as formatting ; deleting old sheets etc - i need to get the below working

The requirement:

Macro needs to read from Formatting worksheet where I currently have Colleges listed in column G; College Code in column H; the name of the relevant worksheet to be created from the Quarter worksheet in column I; and the name of the relevant worksheet to be created from the Year worksheet in column I

I need to create a sheet for each college and title as per columns 'I' for the relevant quarter and copy the information related to that college from the Quarter worksheet.

The below code works fine from the Quarter worksheet however I would prefer if possible no set range as additional colleges may be added in the future. I also need to be able to do the same using the "Year" worksheet and can't seem to get it to work...

Sub Main()
    Dim MyCell As Range, MyRange As Range
     
    Set MyRange = Sheets("Formatting").Range("i2:i19")
    

    For Each MyCell In MyRange
        Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
        Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
        Call Month_Updates(Sheets(Sheets.Count), MyCell.Offset(, -1)) 'copy the information
    Next MyCell
    
    Sheets("Formatting").Select
End Sub

Sub Month_Updates(sh As Worksheet, BU As String)
    With Sheets("Quarter").Range("$A$1:$e$500")
        .AutoFilter Field:=4, Criteria1:=BU
        .Copy sh.Range("A1")
    End With
    
    sh.Columns("A:E").ColumnWidth = 52.73
End Sub

At the moment there are 36 worksheets that need to be created and then saved by the user to their preferred location. I have though 6 sheets that need to remain within the workbook but NOT saved to separate file location ( Formatting; Quarter;Year; All Policy Documents; Table 1 and 2; Table 3). Any assistance with code on the best way to do this also would be appreciated.

Whilst this report is only run quarterly it is very manual in copying and pasting

if anyone could please offer some suggestions would be much appreciated

Kind regards

Shaz

 

[dmt32]

Hi,
is it your intention to consolidate the data from Quarter & Year sheets to the newly created report sheet? or do you intended creating a separate report sheet for each?

Dave

 

[shaz0503]

Hi Dave

I need to create individual sheets for each College from both the Quarter and the Year worksheets.. ie each college will have two worksheets created. I will then need to export all created sheets to relevant file locations..

kind regards

shaz

 

[dmt32]

Hi,
untested but as a start, see if this update to your codes go in the right direction

Sub Main()
    Dim r As Long
    Dim Report As Variant, MyCollege As Variant
    
    With ThisWorkbook.Worksheets("Formatting")
'dynamic range array
        MyCollege = .Range(.Range("H2"), .Range("I" & .Rows.Count).End(xlUp)).Value2
    End With
    
    Application.ScreenUpdating = False
    For r = 1 To UBound(MyCollege, 1)
        For Each Report In Array("Quarter", "Year")
'creates and names new worksheet
            Worksheets.Add(After:=Sheets(Sheets.Count)).Name = Left(MyCollege(r, 2) & " - " & Report, 31)
'copy the information
            Call Month_Updates(ActiveSheet, Report, MyCollege(r, 1))
        Next Report
    Next r
            
    Worksheets("Formatting").Select
End Sub




Sub Month_Updates(ByVal sh As Worksheet, ByVal Report As String, ByVal BU As String)
    With Worksheets(Report).Range("$A$1").CurrentRegion
'clear filters
        .AutoFilter
        .AutoFilter Field:=4, Criteria1:=BU
        .Copy sh.Range("A1")
    End With
    
    sh.Columns("A:E").ColumnWidth = 52.73
End Sub

Dave