Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 10:38:52
Bedingte Formatierung per VBA / MaxPoint
25.04.2024 10:30:04
Suche mit MINWENNS und Rückgabe mehrerer Werte
25.04.2024 09:47:49
Daten aus mehreren Dateien untereinander importieren
25.04.2024 09:31:31
Bild "In Zelle platzieren"
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
752to756
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
752to756
752to756
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro kürzen

Makro kürzen
18.04.2006 11:36:26
Wolfgang
Hallo Excel Freunde,
Ich habe ein Makro aufgezeichnet um Daten aus bestimmten Zellen aus einem Datenblatt in die erste freie Zeile in eine Datenbankblatt zu copieren und dann neu zu sortieren.
Nun ist das Makro recht groß geworden.
Meine Frage ist lässt sich das Makro kürzen, wenn ja wie?
Gruß Wolfgang
Anbei das besagte Makro:

Sub Datenblatt_Werte_nach_DATA_Schreiben()
If MsgBox("Soll der Inhalt des Datenblattes in die Datenbank eingegeben werden ?" _
& Chr(13) & "Die Daten werden in der Datenbank automatisch nach Alphabet einsortiert!", vbQuestion + vbYesNo, "Inhalt des Datenblattes nach DATA Einfügen und Sortieren") = vbYes Then
Application.ScreenUpdating = False
Sheets("Datenblatt").Select
Range("C1").Select                                                          'Firma
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("L1").Select                                                         'Stand
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C2").Select                                                          'Strasse
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 3).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("F2").Select                                                          'PLZ
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 4).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("H2").Select                                                          'Hamburg
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 5).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("L2").Select                                                          'Telefon
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 6).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C3").Select                                                          'Branch/Artikel
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 7).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("H3").Select                                                          'Art / Ort
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 8).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C6").Select                                                          'Eigentümer Name
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 9).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("E6").Select                                                          'Anschrift
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 10).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("H6").Select                                                          'Tel Firma
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 11).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("J6").Select                                                          'Tel.Privat
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 12).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("L6").Select                                                          'Handy
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 13).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("B1").Select                                                          'Zeile14 ObjektNr!!
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 14).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C7").Select                                                           'Verwalter
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 15).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("E7").Select                                                          'Anschrift
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 16).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("H7").Select                                                          'Telefon Firma
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 17).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("J7").Select                                                          'Telefon Privat
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 18).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("L7").Select                                                          ' Handy
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 19).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C8").Select                                                           'Hausmeister1
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 20).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("E8").Select                                                           'Anschrift
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 21).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("H8").Select                                                           'Telefon Firma
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 22).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("J8").Select                                                           'Telefon Priv.
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 23).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("L8").Select                                                           'Handy
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 24).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C9").Select                                                         'Hausmeister2
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 25).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("E9").Select                                                           'Anschrift
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 26).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("H9").Select                                                           'Telefon Firma
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 27).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("J9").Select                                                           'Telefon Privat
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 28).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("L9").Select                                                           'Handy
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 29).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C10").Select                                                          'Sicherheitsdienst
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 30).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("E10").Select                                                          'Anschrift
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 31).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("H10").Select                                                          'Telefon Firma
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 32).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("J10").Select                                                          'Felefon Priv.
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 33).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("L10").Select                                                          'Handy
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 34).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("B1").Select                                                          'Zeile35 ObjektNr!
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 35).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C12").Select                                                         'Info Anfahrt
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 36).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C14").Select                                                         'ASK
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 37).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C15").Select                                                          'Zeile3
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 38).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C16").Select                                                          'Zeile4
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 39).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C17").Select                                                          'Zeile5
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 40).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C18").Select                                                          'Zeile6
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 41).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C19").Select                                                          'Zeile7
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 42).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C20").Select                                                          'Zeile8
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 43).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C21").Select                                                          'Zeile9
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 44).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C22").Select                                                          'Zeile10
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 45).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select                                                  'Zeile11?!!?
Range("C23").Select                                                          'Besondere Risiken1
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 47).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C24").Select                                                           'Besondere Risiken2
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 48).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C25").Select                                                          'Besondere Risiken3
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 49).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C26").Select                                                         'Besondere Risiken4
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 50).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("A30").Select                                                         'Anzahl
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 51).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C30").Select                                                          'Lageplan1
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 52).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C31").Select                                                          'Lageplan2
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 53).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("C31").Select                                                          'Lageplan3
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 54).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("B1").Select                                                         'Zeile 55 ObjektNr!!
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 55).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("E30").Select                                                          'Zugstadorte1
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 56).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("E31").Select                                                          'Zugstandorte2
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 57).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("E32").Select                                                          'Zugstandorte3
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 58).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("G30").Select                                                          'FF1
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 59).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("G31").Select                                                          'FF2
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 60).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("G32").Select                                                         'FF3
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 61).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("I30").Select                                                          'FF4
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 62).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("I31").Select                                                          'FF5
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 63).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("I32").Select                                                          'FF6
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 64).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("K30").Select                                                          'Löschzugfolge1
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 65).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("K31").Select                                                          'Löschzugfolge2
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 66).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("K32").Select                                                          'Löschzugfolge3
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 67).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("M30").Select                                                          'Löschzugfolge4
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 68).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("M31").Select                                                          'Löschzugfolge5
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 69).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("M32").Select                                                          'Löschzugfolge6
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 70).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("N1").Select                                                          'Letzter Bearbeiter
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 71).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Datenblatt").Select
Range("B1").Select                                                          'ObjektNr
Selection.Copy
Sheets("DATA").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Offset(-1 * Not IsEmpty(Cells(1, 1)), 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Call Sortieren_nach_Firma_Aufwärts
Application.ScreenUpdating = True
End If
End Sub

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro kürzen
18.04.2006 11:48:34
Hugo
Hallo,
allgemein: Alle Select weglassen und eine Schleife über eine einzige Anweisung bauen, die schonmal über alle Spalten läuft (1 bis 71). Außenrum noch einen With-Rahmen, der das Sheet "Datenblatt" referenzert. Zudem nicht kopieren sondern Werte direkt zuweisen (wenn möglich).
Bei den zu kopierenden Zellen sehe ich aber keine Systematik. Müsste man irgendwie alle in einem Range-Objekt vereinen (oder einer Stringvariablen, die dann als Range dient), und diese als 2. Schleife durchlaufen.
Nur so Ideen.
Hugo
AW: Makro kürzen -> oh ja ...
18.04.2006 11:50:23
Arthur
Hallo Wolfgang.
Oh ja. Ein winzig wenig kürzen ist möglich.
a) Jeweils von "Sheets(" bis "ActiveSheet.Cells" ist faktisch da Selbe. Also ab in eine Subroutine. Als Parameter den Bezug mitgeben.
Sub CopyPaste (byval ptRange as string)
Sheets...
Range(ptRange).Select
...
b) Active.Cell.xxxxx.Select und dann paste läßt sich evtl abkürzen, indem per UsedRange die letzte Zeile ausgewählt wird.
Gruß
Arthur
Anzeige
AW: Makro kürzen
18.04.2006 12:18:21
Hugo
Hallo,
nach diesem Muster:
Option Explicit

Sub ungetestet()
Dim C As Range, s As String, l As Integer, j As Long
s = "B1:C1,L1,C2,F2,H2,L2,C3,H3,C6,E6,H6,J6,L6,B1,C7,E7,H7,J7,L7,C8,E8,H8,J8,L8,C9,E9,H9,J9,L9,C10,E10,H10,J10,L10,B1,C12,C14:C26,A30,C30,C31,C31,B1,E30:E32,G30:G32,I30:I32,K30:K32,M30:M32,N1"
l = 1
With Sheets("Datenblatt")
j = Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
For Each C In .Range(s)
Sheets("Data").Cells(j, l) = C
l = l + 1
Next C
End With
End Sub

Hugo
AW: Makro kürzen
18.04.2006 15:01:51
Wolfgang
Hallo Hugo,
klappt fast perfekt.
Bis auf Zelle L1 da steht ein Datum, daß wird nicht korrekt übernommen.
Beispiel: Datenblatt Zelle L1 = 30.11.2005 wird in DATA 01.12.2009
Warum?
Nun muß ich dazu sagen das die Zelle L1 mit M1 verbunden sind, vielleicht liegt da der Fehler?
Wenn Du noch ein Tipp hast.
Ich danke Dir recht herzlich für Deine Mühe Dir Du gemacht hast.
Auch allen Andern sei gedankt.
Gruß Wolfgang
Anzeige
AW: Makro kürzen
18.04.2006 15:29:03
Hugo
Hallo,
kann sein, dass es an der verbundenen Zelle liegt.
Prüf mal, ob der lange String die Zellen exakt in der Reihenfolge enthält, wie sie - der Reihenfolge nach - in die Spalten 1 bis 71 eingetragen werden sollen.
Hugo
AW: Makro kürzen
18.04.2006 15:41:11
Wolfgang
Hi,
an den verbunden Zellen kann es nicht liegen.
Ich hab zur Probe die Zellverbund aufgelöst.
Dennoch das gleiche Ergebnis.
Auch werden die Daten in die richtigen Reihenfolge in die Zeile geschrieben.
Nur wird immer das Datum + 4 Jahre geschrieben!! Merkwürdig
Gruß Wolfgang
AW: Makro kürzen
18.04.2006 16:28:07
Hugo
Hallo,
"Nur wird immer das Datum + 4 Jahre geschrieben!! Merkwürdig"
Extras-Optionen-Berechnung-Haken raus bei "1904-Datumswerte".
Aber Achtung: Vorhandene Datums werden dabei wieder umgerechnet.
Hugo
Anzeige
AW: Makro kürzen - Es ist geschafft
18.04.2006 16:46:56
Wolfgang
Hi Hugo,
ich Danke Dir vielmals für Deine Hilfe.
Es funktioniert tadellos und wunderbar.
Gruß Wolfgang

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige