VBA: Copy Sheets and Paste into a new Excel, if Cell has a name

[EdgarExcel]

Hello all,

this is one of my first attempts at VBA, so I am stil struggling a lot. Let me please explain, what result I want to generate:

I have an Excel Data, which contains About 80 Sheets.
1 I want to go through every sheet
2 If the Cell D18 contains a specific Name (Example: Max Mustermann), then I want to copy it
3 Every Sheet which contains "Max Mustermann": I want to save it in the same new Excel as Step (2)
4 The formatting should be the same as in the original excel
5 After generating all Sheets of "Max Mustermann", I want to save them in my folder

6: Step 1-5 should be repeated for About 20 different Names
7: If possible, it would be great if the names could be linked to the Sheet "Definitions" - I mean, that there is a list of the 20 names and it should run through every Name and copy/save a new excel for every Name.
--> Sheet "Definitions" and Cells (A85:105)

I know, that I ask for a lot but I am struggling because of its complexity. Here is my first attempt, which does not completely work:


Sub TestMustermannSheets()

Worksheets(1).Activate
Dim intNumberSheets As Integer

For intNumberSheets = 1 To (ActiveWorkbook.Worksheets.Count - 1)

If Range("D18").Value Like "*Max Mustermann*" Then
ActiveSheet.Copy


Else
ActiveSheet.Next.Activate

End If
Next
ActiveWorkbook.SaveAs Filename:= _
"\\Speicherpfad\2020_Max_Mustermann.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

End Sub


It would be very nice, if you could help me. Even if it was only for one specific Name instead of the whole list.
Thanks a lot!

Greetings,
Edgar

 

[yinkajewole]

I need some clarifications
2. When cell D18 is copied, are you pasting it elsewhere or what?
3.

I want to save it in the same new Excel as Step (2)

means what?
7. Does not 20 names means the file names of the workbooks?