Supportnet / Forum / Tabellenkalkulation
Makro - Definitionsproblem Loesung
Frage
Habe nun die Loesung (Dank Guenters Tip). Meinen Topic kann ich nicht mehr fortsetzen (keine Ahnung wieso).
---
Sub Suche()
Dim Eingabe As Long
Dim Blattname As String
Eingabe = ThisWorkbook.Sheets("Master").Range("G6").Value
Blattname = Eingabe
If Not IsNumeric(Eingabe) Then
MsgBox ("Ungueltige Nummer"), 48, "Ueberprüfung"
GoTo Abbruch
End If
'Formular kopieren
Sheets("Formular").Select
Application.CutCopyMode = False
Sheets("Formular").Copy After:=Sheets(3)
ActiveSheet.Name = Blattname
'Suche in Datenbank
ThisWorkbook.Sheets("Datenbank").Activate
ActiveSheet.[A1].Select
With ActiveCell
While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = Eingabe Then
'Daten der eingegebenen Nummer in Formular eintragen
Worksheets(Blattname).Range("F9").Value = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
Worksheets(Blattname).Range("F11").Value = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
Worksheets(Blattname).Range("F13").Value = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
Worksheets(Blattname).Range("F15").Value = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
Worksheets(Blattname).Range("F17").Value = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
Worksheets(Blattname).Range("F19").Value = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
Worksheets(Blattname).Range("F21").Value = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
Worksheets(Blattname).Range("F23").Value = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
Worksheets(Blattname).Range("F25").Value = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
Worksheets(Blattname).Range("F27").Value = ActiveCell.Value
ThisWorkbook.Sheets(Blattname).Activate
Exit Sub
End If
Wend
End With
Abbruch:
End Sub