Problem mit Makro
16.09.2005 12:17:50
Ralf
ich habe folgendes Problem: ich füge gerade zu einer existierenden Tabelle Datenbestände hinzu. Es existiert ein Makro, dass bestimmte Datensätze dieser Tabelle entnehmen (bzw. kopieren) und in eine andere Tabelle einfügen soll. Diese Funktion erfüllt das Makro auch weitestgehen, außer - das meine neuen Datenbeständen (die einfach nur unten an stehen) ignoriert werden. Die Ranges im Makro habe ich eigentlich soweit verändert, dass sie mit übernommen werden müssten.
Nun das 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