Makro um IF * erweitern
27.05.2009 22:15:36
Justine
ich hab mir ein makro gebastelt, welches mir aus ein tabellenblatt die infos auf ein deckblatt zieht die ich brauche. nur brauche ich jetzt eine möglichkeit das mein makro bei der eingabe von einen * automatisch das makro auf allen tabellenblätter laufen lässt.
kann mir dabei jemand helfen.
hier mein makro
Sub Versuch1()
Dim TabelleNr As String
' Kopie und Einfügen der Daten in das Deckblatt
'Application.DisplayAlerts = False
Application.ScreenUpdating = False
TabelleNr = InputBox("Bitte wählen Sie ein Tabellenblatt aus:")
On Error GoTo Fehler:
Sheets(TabelleNr).Select
Range("az1").Select
ActiveCell = ActiveSheet.Name
Selection.Copy
Sheets("Deckblatt").Select
Range("A21").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(TabelleNr).Select
Range("B6").Select
Selection.Copy
Sheets("Deckblatt").Select
Range("C21").Select
ActiveSheet.Paste
Range("D21").Select
Sheets(TabelleNr).Select
Range("L6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Deckblatt").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("E21").Select
Sheets(TabelleNr).Select
Range("G6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Deckblatt").Select
Range("E21").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("G21").Select
Sheets(TabelleNr).Select
Range("G5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Deckblatt").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'Range("A21").Select
'Application.CutCopyMode = False
'ActiveCell.FormulaR1C1 = "Eintrag Tab"
Range("A9:G21").Select
Selection.Sort Key1:=Range("A9"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Application.ScreenUpdating = True
Fehler:
End Sub