Code blählt Arbeitsmappe auf ??? Hilfe !
28.01.2004 16:16:57
Lars
Habe folgendes Problem:
In meiner Excel Arbeitsmappe befindet sich zu Anfang nur ein Blatt mit verschiedenen Daten von Firmen. Mit meinem Makro sortiere ich den Inhalt des Blattes nach den Firmen, erstelle von jeder Firma ein eigenes Tabellenblatt und kopiere die zur Firma zugehörigen Daten herein. Der Code funktioniert auch, allerdings mußte ich zu meinem Entsetzen feststellen, das aus einer Mappe mit 50 KB nach dem Durchlaufen des Makros ca. 30 (!) MB geworden sind. Wer kann mir helfen den Code zu optimieren ??? Die zweite Frage ist, wie muß ein Makro aussehen, daß jeder Firma das zugehörige Tabellenblatt an einen vorher zugewiesenen Email Kontakt schickt ??
Hier der Code (auszugsweise):
Sub Oustanding_Order_Thomas()
Application.ScreenUpdating = False
Sheets("Sheet1").Select
ActiveWindow.ScrollColumn = 1
Selection.AutoFilter Field:=1, Criteria1:="Firma1"
Sheets.Add
'***********************Blatt hinzufügen*******************************************
Sheets("Tabelle1").Select
Sheets("Tabelle1").Move After:=Sheets(2)
ActiveWindow.TabRatio = 0.392
ActiveWindow.ScrollWorkbookTabs Sheets:=-1
'************************Blatteinstellungen*****************************************
Sheets("Tabelle1").Select
Sheets("Tabelle1").Name = "Firma1"
Sheets("Sheet1").Select
Range("A:A,F:G").Select
Range("F1").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Firma1").Select
Range("B1").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Columns("J:J").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Firma1").Select
Range("E1").Select
ActiveSheet.Paste
Range("G2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUM(C[-2])"
Range("G2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Selection.Font.Bold = True
Selection.Font.ColorIndex = 3
Sheets("Sheet1").Select
ActiveWindow.ScrollColumn = 1
ActiveWindow.TabRatio = 0.958
Selection.AutoFilter Field:=1
Range("A1").Select
Application.ScreenUpdating = True
(selbe Code für Firma 2-10)
...
End Sub
Code eingefügt mit Syntaxhighlighter 2.4