wer von euch kann mir sagen, warum das folgende makro nicht läuft.Dabei geht es um folgendes. Nach der Eingabe einer laufenden Nummer soll ein Beleg gedruckt werden. Dazu soll in einer Datenbank ein Datensatz ausgelesen werden, der die spalten 1 bis 32 umfasst. Die Datenbank beginnt ab Zeile 11. Jetzt soll über ein Eingabefenster die laufende Nummer eingegeben werden von 1 bis 290. Anhand dieser Nummer (Sie steht in der Datenbank in Spalte A)soll die entsprechende Zeile in Zeile 1 kopiert werden. Ein Druckblatt habe ich schon vorbereitet (Die in Zeile 1 kopierten Daten werden automatisch dort angezeigt.)die zu druckenden Bereiche heissen Englisch und Kopie1. Datenbak und Druckbereiche sind im gleichen Blatt. Trotzdem kopiert mein Makro nicht die entsprechende Zeile in Zeile 1. Ich habe auch schon eine zweite Variante gestestet, aber auch die läuft nicht.
Sub test()
'
' test Makro
Dim Mldg
Mldg = "Bitte lfd. Nr. eingeben"
Titel = "InputBox"
Voreinstellung = "1"
Suchwert = InputBox(Mldg, Titel, Voreinstellung)
zeile = 11
Do Until zeile < 301
Cells.Find(What:=Suchwert, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:="", MatchCase:= _
False).Activate
Range(Cells(zeile, 1), Cells(zeile, 23)).Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveSheet.PageSetup.PrintArea = "Buchungsanzeige"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.8)
.RightMargin = Application.InchesToPoints(0.3)
.TopMargin = Application.InchesToPoints(0.4)
.BottomMargin = Application.InchesToPoints(0.35)
.HeaderMargin = Application.InchesToPoints(0.511811023)
.FooterMargin = Application.InchesToPoints(0.511811023)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = 1
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveSheet.PageSetup.PrintArea = "Kopie"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.8)
.RightMargin = Application.InchesToPoints(0.3)
.TopMargin = Application.InchesToPoints(0.4)
.BottomMargin = Application.InchesToPoints(0.35)
.HeaderMargin = Application.InchesToPoints(0.511811023)
.FooterMargin = Application.InchesToPoints(0.511811023)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = 1
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
zeile = zeile + 1
Loop
Range("A1").Select
Range("A1").Select
End Sub
bzw. der andere Versuch:
Dim Mldg
Mldg = "Bitte lfd. Nr. eingeben"
Titel = "InputBox"
Voreinstellung = "1"
Suchwert = InputBox(Mldg, Titel, Voreinstellung)
zeile = 11
If Cells.Find(What:=Suchwert, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:="", MatchCase:= _
False).Activate = Suchwert.Value Then
Range(Cells(zeile, 1), Cells(zeile, 23)).Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveSheet.PageSetup.PrintArea = "Buchungsanzeige"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.8)
.RightMargin = Application.InchesToPoints(0.3)
.TopMargin = Application.InchesToPoints(0.4)
.BottomMargin = Application.InchesToPoints(0.35)
.HeaderMargin = Application.InchesToPoints(0.511811023)
.FooterMargin = Application.InchesToPoints(0.511811023)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = 1
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveSheet.PageSetup.PrintArea = "Kopie"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.8)
.RightMargin = Application.InchesToPoints(0.3)
.TopMargin = Application.InchesToPoints(0.4)
.BottomMargin = Application.InchesToPoints(0.35)
.HeaderMargin = Application.InchesToPoints(0.511811023)
.FooterMargin = Application.InchesToPoints(0.511811023)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = 1
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Else: Do Until Cells.Find(What:=Suchwert, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:="", MatchCase _
:=False).Activate = Suchwert.Value
zeile = zeile + 1
Loop
End If
Range("A1").Select
VIELEN DANK im voraus für die schnelle Hilfe.
Andreas