How? I have a macro that i need 50 varients of with minor changes Advice help please

[AkaTrouble]

Hello

i have a macro that i need 50 varients of (same macro with 50 slightly different variables)

the differences are basically from original List1 i want to change or input number 1-50 and it carries out the code based on this input

the other MAIN difference is that the copy block of data Range on master sheet moves 5 columns to right with each increase in List number

for example in List1 macro (below) copy range is AF6 : AH31 in List2 this would be AK6 : AM31 in List3 AP6 : AR31 same rows of data just 5 columns to the right for each increase in number list.

the "WorkingList" and "ListMaster" references remain unchanged (except for above copy block) The Paste too areas on each list are the same for each List number. Basically creating an identical sheet for each list selected with page name of list number.

i am flexible on method for user to select which List Number they want either a drop down list or an input box when macro is run or ..... I would like to assign the macro to a button for user to click ( i know how to do this)

I hope i have given enough information, if not please ask

below i have put first code block macro for List1 and List2 as separate macros to help understand the changes as List number increase

Thanks for reading

Sub List1()

'to check if sheet exists
Dim sh As Worksheet, flg As Boolean
For Each sh In Worksheets
If sh.Name Like "List1*" Then flg = True: Exit For
Next
If flg = True Then
Else
Sheets.Add.Name = "List1"
End If

    Sheets("List1").Select
    Range("A1").Select
   
    'Create new sheet from master Template (hidden sheet)
    Sheets("ListMaster").Visible = True
        Sheets("ListMaster").Select
        Cells.Select
       Selection.Copy
       Sheets("ListMaster").Visible = False
    
    Sheets("List1").Select
    ActiveSheet.Paste
    Range("A1").Select
    
    Sheets("WorkingList").Select
    Range("F2:H30").Select
    Selection.Copy
    Sheets("List1").Select
    Range("F2:H3").Select
    ActiveSheet.Paste
    Sheets("WorkingList").Select
    Range("AF6:AH31").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("List1").Select
    Range("A5").Select
    ActiveSheet.Paste
    
    'place borders around after copy
    Range("A2:H30").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With

    Range("A5:C30").HorizontalAlignment = xlCenter
    Range("A1").Value = "List 1"
    Range("A1").Select
    
    MsgBox "Completed"
    
End Sub

i have coloured changes in List2 below

Sub List[COLOR=#ff0000]2[/COLOR]()

'to check if sheet exists
Dim sh As Worksheet, flg As Boolean
For Each sh In Worksheets
If sh.Name Like "List[COLOR=#ff0000]2[/COLOR]*" Then flg = True: Exit For
Next
If flg = True Then
Else
Sheets.Add.Name = "List[COLOR=#ff0000]2[/COLOR]"
End If

    Sheets("List[COLOR=#ff0000]2[/COLOR]").Select
    Range("A1").Select
   
    'Create new sheet from master Template (hidden sheet)
    Sheets("ListMaster").Visible = True
        Sheets("ListMaster").Select
        Cells.Select
       Selection.Copy
       Sheets("ListMaster").Visible = False
    
    Sheets("List[COLOR=#ff0000]2[/COLOR]").Select
    ActiveSheet.Paste
    Range("A1").Select
    
    Sheets("WorkingList").Select
    Range("F2:H30").Select
    Selection.Copy
    Sheets("List[COLOR=#ff0000]2[/COLOR]").Select
    Range("F2:H3").Select
    ActiveSheet.Paste
    Sheets("WorkingList").Select
    Range("[COLOR=#ff0000]AK6:AM31[/COLOR]").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("List[COLOR=#ff0000]2[/COLOR]").Select
    Range("A5").Select
    ActiveSheet.Paste
    
    'place borders around after copy
    Range("A2:H30").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With

    Range("A5:C30").HorizontalAlignment = xlCenter
    Range("A1").Value = "List [COLOR=#ff0000]2[/COLOR]" [COLOR=#ff0000]'space is intentional[/COLOR]
    Range("A1").Select
    
    MsgBox "Completed"
    
End Sub

 

[AkaTrouble]

ok update

i have managed to solve most of it by creating input box and assigning list number to a varible (see new macro below)

the only bit i am now struggling with is this line of the macro

Range("AF6:AH31").Select

how can i move it 5 columns to right based on input number


current macro working for all other parts

Sub ListSelect()

Dim SName As String
Dim Lname As Variant

Lname = InputBox("please input number of List you want 1 - 50 (as number)")
SName = "List" & Lname


Dim sh As Worksheet, flg As Boolean
For Each sh In Worksheets
If sh.Name Like SName Then flg = True: Exit For
Next
If flg = True Then

Else
Sheets.Add.Name = SName
End If

    Sheets(SName).Select
    Range("A1").Select
   
    Sheets("ListMaster").Visible = True
    Sheets("ListMaster").Select
    Cells.Select
    Selection.Copy
    Sheets("ListMaster").Visible = False
    
    Sheets(SName).Select
    ActiveSheet.Paste
    Range("A1").Select
    
    Sheets("WorkingList").Select
    Range("F2:H30").Select
    Selection.Copy
    Sheets(SName).Select
    Range("F2:H3").Select
    ActiveSheet.Paste
    Sheets("WorkingList").Select
    Range("AF6:AH31").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(SName).Select
    Range("A5").Select
    ActiveSheet.Paste
    
    Range("A2:H30").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Range("A5:C30").HorizontalAlignment = xlCenter
    Range("A1").Value = "List " & Lname
    Range("A1").Select
    
    MsgBox "Completed"
    
End Sub

 

[AkaTrouble]

i have asked a new question as a new post with regard to outstanding problem

http://www.mrexcel.com/forum/excel-...s-right-each-increase-number.html#post4675882

i have stated on that post it is part of this original question