Making sheet from 2 different tables

[Dalacarelia]

Hello

My Macro problem to solve is like this

I have a One Sheet with name "

Input_Sheet "​

list 4 colums wide

Col1 (A) Defines name "PeterE" up to 50 names
Col2 (B) ( DefineType) GG or YRK

I have 2 TemplateSheet "GGTemplate and YRKTemplate and i need excel to make copy of the sheet for the right Type .

If its magic i will have 4 new sheets from 2 different templates and the nametable are sorted i alfabetic order colum A

My in my file i have 4 sheets with other information too so the new sheets need tobe added last
​

I have a solution for 1 Sheet but not with combo

_{^{<strike>
</strike>}}

Colum A ( After macro runs alfabetic order )	Colum B
Name​ <strike></strike>	<strike></strike><strike></strike>Type
PeterZ ​ <strike></strike>	GG
PeterK ​ <strike></strike>	YRK
PeterM​ <strike></strike>	GG
PeterE​	YRK

<tbody>
</tbody>

​

​

Macro i need to fix

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sub Mixa_ihopGG()
'
Columns("A:C").Select
ActiveWorkbook.Worksheets("

Input_Sheet​

).AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("

Input_Sheet​

").AutoFilter.Sort.SortFields.Add2 Key _
:=Range("A1:A100"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("

Input_Sheet​

").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A2").Select

Dim sh1 As Worksheet, sh2 As Worksheet, c As Range
Set sh1 = Sheets("

GGTemplate​

")
Set sh2 = Sheets("Input_Sheet")
For Each c In sh2.Range("A2", sh2.Cells(Rows.Count, 1).End(xlUp))
sh1.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value
Next[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif][/FONT]
[/FONT][FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]
[/FONT]

 

[Dalacarelia]

I took my Coke and use the time and i find a solution

And here we go

Dim ws As Worksheet, Ct As Long, c As Range
Set ws = Worksheets("Mallblad_YRK")
Application.ScreenUpdating = False
For Each c In Sheets("Indata_bladet").Range("E2:E20")
If c.Value <> "" Then
ws.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value
Ct = Ct + 1
End If
Next c
If Ct > 0 Then
MsgBox Ct & " Nya blad ?r skapade fr?n Yrklistan"
Else
MsgBox "Inga Yrknamn"
End If
Application.ScreenUpdating = True

Dim ws2 As Worksheet, Ct2 As Long, c2 As Range
Set ws2 = Worksheets("Mallblad_GG")
Application.ScreenUpdating = False
For Each c2 In Sheets("Indata_bladet").Range("A2:A20")
If c2.Value <> "" Then
ws2.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = c2.Value
Ct2 = Ct2 + 1
End If
Next c2
If Ct2 > 0 Then
MsgBox Ct2 & " Nya blad ?r skapade fr?n GG listan"
Else
MsgBox "Inga GG namn i listan "
End If
Application.ScreenUpdating = True




It works out fine