Problem mit Makro

Sub GenerateOrderList() Sheets("Product Portfolio").Select Columns("A:S").Select Selection.Copy Sheets("Order List").Select Range("A1").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("Product Portfolio").Select Cells.Select Application.CutCopyMode = False Selection.Copy Sheets("Order List").Select Cells.Select Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Range("G7:I7").Select Selection.ClearContents Range("D7").Select hoehe = 0 Columns("R:R").Select Selection.ColumnWidth = 20 ' Enter here size of list (number of lines) ' Fields in column R must be interger (no strings) ActiveWindow.View = xlNormalView ActiveWindow.Zoom = 60 n = 430 Do While (n > 3) n = n - 1 aktuelles_Feld = "R" + StrConv(n, 1) Range(aktuelles_Feld).Select hoehe = CInt(ActiveCell.FormulaR1C1) ' If hoehe < 0.01 Then Selection.EntireRow.Delete If hoehe < 0.01 Then Selection.RowHeight = 0 Loop ActiveSheet.PageSetup.PrintArea = "" ActiveWindow.DisplayZeros = False Columns("J:W").Select Selection.ColumnWidth = 0 Sheets("Product Portfolio").Select Range("A1").Select Sheets("Order List").Select Range("A1:I430").Select Range("A420").Activate ActiveSheet.PageSetup.PrintArea = "$A$1:$I$430" Range("A3").Select ActiveWindow.View = xlPageBreakPreview ActiveWindow.Zoom = 60 End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
damit habe ich auch Probleme. Da steht soviel Unsinn drin, dass ich nicht ganz kapiere, was du eigentlich willst.
Der Hammer ist das hier:
Do While (n &gt 3)
n = n - 1
aktuelles_Feld = "R" + StrConv(n, 1)
Range(aktuelles_Feld).Select
hoehe = CInt(ActiveCell.FormulaR1C1)
' If hoehe &lt 0.01 Then Selection.EntireRow.Delete
If hoehe &lt 0.01 Then Selection.RowHeight = 0
Loop
Du bastelst dir einen String und wandelst dabei eine Zahl (n) in einen Großbuchstaben um StrConv(n,1)?
Anschließend selectest du die Zelle und wandelst die Formel (!!!) in eine Ganzzahl um.
Diese Ganzzahl prüfst du auf kleiner 0,01 also keine Ganzzahl.
Dazu noch die Unzahl an Selects.
Verstehst du den Code überhaupt? Überdenke dein Level.
Gruß ausm Pott
Udo

Hallo,
hier noch mal eine überarbeitete Version.
M.E. müssen alle Zeilen kopiert werden. So weit ist dein Makro ok.
Wenn Werte nicht erscheinen kann das eigentlich nur daran liegen, dass die Zeilen im weiteren Verlauf ausgeblendet werden.
Die Ermittlung der lezten Zeile ist in dieser Version automatisiert.
Alle nicht benötigten Einträge sind auf Kommentar gesetzt "'".
Gruß
John


Sub GenerateOrderList()
Sheets("Product Portfolio").Select
Columns("A:S").Copy
'   Selection.Copy
Sheets("Order List").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues
Selection.PasteSpecial Paste:=xlFormats
'    Sheets("Product Portfolio").Select
'    Cells.Select
'    Application.CutCopyMode = False
'   Selection.Copy
'   Sheets("Order List").Select
'   Cells.Select
'   Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
'       False, Transpose:=False
Application.CutCopyMode = False
'  warum muss du aus diesem Bereich die Daten löschen?
Range("G7:I7").ClearContents
'    Range("D7").Select
hoehe = 0
Columns("R:R").ColumnWidth = 20
' Enter here size of list (number of lines)
' Fields in column R must be interger (no strings)
ActiveWindow.View = xlNormalView
ActiveWindow.Zoom = 60
'    n = 430
'   hier wird die anzahl der Zeilen gesetzt
n = ActiveCell.SpecialCells(xlLastCell).Row + 1
letzteZeile = n - 1
Do While (n > 3)
n = n - 1
aktuelles_Feld = "R" + StrConv(n, 1)
Range(aktuelles_Feld).Select
'        hoehe = CInt(ActiveCell.FormulaR1C1)
'Ist die Zeilenhöhe vom Wert des Inhalts abhängig, dann so ...
hoehe = ActiveCell
'  If hoehe < 0.01 Then Selection.EntireRow.Delete
'      If hoehe < 0.01 Then Selection.RowHeight = 0
If hoehe < 0.01 Then Selection.EntireRow.Visible = False
Loop
ActiveSheet.PageSetup.PrintArea = ""
ActiveWindow.DisplayZeros = False
Columns("J:W").Select
Selection.ColumnWidth = 0
Sheets("Product Portfolio").Select
Range("A1").Select
Sheets("Order List").Select
'    Range("A1:I430").Select
Range("A1:I" & letzteZeile).Select
'    Range("A420").Activate
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$" & letzteZeile
Range("A3").Select
ActiveWindow.View = xlPageBreakPreview
ActiveWindow.Zoom = 60
End Sub

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread