auf Gliederungen + zurücksetzen
31.08.2008 12:36:58
Lemmi
ich führe das nachfolgende Marko .. Einfügen_Block.. aus und bekomme nicht immer eine einwandfrei kopie hin! In dem Bereich der Kopiert werden soll besteht eine Gliederung, teilweise geöffnet oder geschlossen ist!
Wenn also die Gliederung teilweise eingestellt (Gliederung -) oder teilweise ausgestellt ist ( Gliederung +)
werden nicht alle Elemente kopiert!
Wenn nun alle Gliederungen ausgestellt ( Gliederung +) sind funktioniert alles tadellos!
Kann man das vorhandene Marko ergänzen in dem man grundsätzlich alle vorhandenen Gliederungen ausstellt (Gliederung +) bevor der im Marko durchgeführte Kopiervorgang durchgeführt wird?
Sub Einfügen_Block()
Dim lngLetzte As Long, lngNrLetzte As Long
Dim wks As Worksheet
Set wks = ActiveSheet 'ggf. Name anpassen
With wks
'letzte benutzte Zeile in Spalte A
lngLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
'letzte Nr. in Spalte A
lngNrLetzte = .Cells(lngLetzte, 1) 'letzte Nr. in Spalte A
'Zeilen kopieren
.Range(.Rows(6), .Rows(12)).Copy
.Cells(lngLetzte + 1, 1).Insert
'neue Nr in Spalte A für eingefügte Zeilen eintragen
.Range(.Cells(lngLetzte + 1, 1), .Cells(lngLetzte + 7, 1)).Value = lngNrLetzte + 1
'Eingabewerte in kopierter Überschrift löschen
.Range(.Cells(lngLetzte + 1, 3), .Cells(lngLetzte + 1, 14)).ClearContents 'Spalten C bis N
.Cells(lngLetzte + 1, 16).ClearContents 'Spalte P
'Eingabewerte in kopierten 6 Zeilen löschen
.Range(.Cells(lngLetzte + 2, 3), .Cells(lngLetzte + 7, 16)).ClearContents 'Spalten C bis _
P
End With
End Sub
Gruß
Lemmi