Excel Makro für Datenbank

[NNemo]

Hallo leute ich bin schon seit 11:00 uhr am suchen und finde keine lösung. Bitte Helft mir!

Ich muss Personal Daten erstellen/sotieren und in eine Datenbank hinzufügen...

Klingt erstmal nicht sooo schlimm klar.

Das Problem ist die Daten sind in vielen PDF´s eine PDF für eine Personen (weit über 200 PDF´s und schnell weiter steigend).
Die soll ich in einer Excel Tabelle oder Access Datenbank einpflegen. So das wenn ich den Namen von einer person eingebe sofort die daten zu sehen sind die von ihm gespeichert wurden.

Was ich jetzt versuche ist, die daten aus den vielen PDF´s mit hilfe von Makro´s in eine Exel Tabelle untereinander zu kopieren.

Person1 ---> Daten
person2 ---> Daten
usw.

so soll es aussehen am ende.

ich habe es schon geschaft mit einem tool alle daten von PDF in xls umzuwandeln, so das alle personen in einer xls sind.

was ich jetzt versucht habe hinzubekommen ist, mit der Makro aufnahme funktion. Das er sucht Kopiert und dann in einem neuen sheet untereinander einzufügen.

hier der code:

Sub test1()
'
' test1 Makro
'

'
Cells.Find(What:="Geburtsdatum", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range("B6:C6").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
Sheets("Sheet 1").Select
Selection.Find(What:="Nationalität", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Range("C6").Select
Cells.Find(What:="Nationalität", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range("B7:C7").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Next.Select
Range("C1").Select
ActiveSheet.Paste
Range("C1").Select
ActiveSheet.Previous.Select
Selection.Find(What:="hauttyp", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range("C7").Select
Cells.Find(What:="hauttyp", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range("B8:C8").Select
Application.CutCopyMode = False
Selection.Copy
Range("C8").Select
ActiveSheet.Next.Select
Range("E1").Select
ActiveSheet.Paste
Range("G1").Select
ActiveSheet.Previous.Select
Cells.Find(What:="straße", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Range("B12:C12").Select
Application.CutCopyMode = False
Selection.Copy
Range("C12").Select
ActiveSheet.Next.Select
Range("G1").Select
ActiveSheet.Paste
Range("I1").Select
ActiveSheet.Previous.Select
Cells.Find(What:="plz", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Range("B13:C13").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Next.Select
ActiveSheet.Paste
ActiveSheet.Previous.Select
Range("C13").Select
Cells.Find(What:="nächstegrößere", After:=ActiveCell, LookIn:=xlFormulas _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Cells.Find(What:="nächstgrößere", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range("B14:C14").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Next.Select
Range("K1").Select
ActiveSheet.Paste
ActiveSheet.Previous.Select
Range("C14").Select
Cells.Find(What:="fon (1)", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range("B15:C15").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Next.Select
Range("M1").Select
ActiveSheet.Paste
ActiveSheet.Previous.Select
Range("C15").Select
Cells.Find(What:="fon (2)", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range("B16:C16").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Next.Select
Range("O1").Select
ActiveSheet.Paste
ActiveSheet.Previous.Select
Range("C16").Select
Cells.Find(What:="fon, mobil", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range("B17:C17").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Next.Select
Range("Q1").Select
ActiveSheet.Paste
Range("S1").Select
ActiveSheet.Previous.Select
Range("C17").Select
Cells.Find(What:="Fax", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Range("B18:C18").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Next.Select
Range("S1").Select
ActiveSheet.Paste
Range("U1").Select
ActiveSheet.Previous.Select
Range("C18").Select
Cells.Find(What:="e-mail", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Range("B19:C19").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Next.Select
ActiveSheet.Paste
Range("W1").Select
ActiveSheet.Previous.Select
Range("C19").Select
Application.CutCopyMode = False
End Sub

es funktioniert aber nicht...

habt ihr Tipps ?

was ich schaffen will

so sollte es aussehen nur mit den daten der personen aus der PDF untereinander weg stehend.




Hilfe...