Anzeige
Archiv - Navigation
1192to1196
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
Inhaltsverzeichnis

PasteSpecial ,Code verbessern

PasteSpecial ,Code verbessern
frank
Hallo
Habe ein Makro das ich verbessern möchte.
Es kommt 2 mal PasteSpecial vor. Einmal um mehrere Zeilen einzufügen und einmal um eine Formel in Wert zu änderrn. In der Zelle steht das aktuelle Datum =heute(). Die Zelle befindet sich in den zu kopierenen Zeilen.
Geht das nicht in einmal?
Sub FormularDruckenUndInsArchiv()
Application.ScreenUpdating = False
If Application.WorksheetFunction.CountA(Range("C9:J19")) = 0 Then
Range("A1:J20").PrintOut 'leeres Protokoll drucken
Exit Sub
Else
Range("A1:J20").PrintOut 'gefülltes Protokoll drucken
Rows("1:21").Select 'Spalten ins Archiv kopieren nach unten
Selection.Copy
Sheets("Archiv").Select
Selection.Insert Shift:=xlDown
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False 'zeilen und spaltenformate bleiben erhalten
ActiveSheet.DrawingObjects.Delete
Range("J1").Select 'hier steht das aktuelle Datum, soll sich im Archiv nicht mehr ändern
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Protokoll").Range("C5:F19,G7:J19,I5:J6,G5:H5,C20,E20").ClearContents 'Protokoll  _
leeren
End If
Application.ScreenUpdating = True
End Sub

Danke
frank

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: PasteSpecial ,Code verbessern
12.01.2011 21:05:06
Hajo_Zi
Hallo Frank,
vielleicht so.
Option Explicit
Sub FormularDruckenUndInsArchiv()
Application.ScreenUpdating = False
If Application.WorksheetFunction.CountA(Range("C9:J19")) = 0 Then
Range("A1:J20").PrintOut 'leeres Protokoll drucken
Exit Sub
Else
Range("A1:J20").PrintOut 'gefülltes Protokoll drucken
Rows("1:21").Copy
With Sheets("Archiv")
.Range("Zelle unbekannt").Insert Shift:=xlDown
.Range("Zelle unbekannt").PasteSpecial Paste:=xlPasteColumnWidths
.DrawingObjects.Delete
.Range("J1").Copy
.Range("J1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
Sheets("Protokoll").Range("C5:F19,G7:J19,I5:J6,G5:H5,C20,E20").ClearContents 'Protokoll  _
_
leeren
End If
Application.ScreenUpdating = True
End Sub

Anzeige
Danke Hajo - Wieder viel gelernt - O.T.
12.01.2011 22:01:27
frank
.

121 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige