VBA-Code ergänzen

Hallo Freaks,
ich möchte einen Code ergänzen.


Sub Optimale_Zeilenhöhe()
ActiveSheet.Unprotect Password:="Passwort"
Rows("11:211").Select
Selection.Rows.AutoFit
Range("a11:d211").Select
Selection.Locked = False
ActiveSheet.EnableAutoFilter = True ' Für AutoFilter
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
UserInterfaceOnly:=True, Password:="Passwort"
Range("D11").Select
End Sub

Vorstehender Code (ohne Sub) will ich in nachstehenden Code einfügen, krieg es aber nicht hin, da ich VBA nur mit Rekorder umsetzen kann:
If Cells(9, 25).Value > 0 Then
?....
?....
Sheets("Protokolltext").Range("B10:D10").Copy Destination:=Sheets("Protokolltext").Range("B11:D211")
?....
?....
End If
Die Funktion soll in der Tabelle "Protokolltext" ablaufen, in die ich aus einer anderen Tabelle verzweige und danach wieder in die Ursprungstabelle der gleichen Arbeitsmappe zurückkehre.
Bin für jede Unterstützung dankbar.
Gruß
Konni

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub Optimale_Zeilenhöhe() Dim merker Application.ScreenUpdating = False merker = ActiveSheet.Name With Worksheets("Protokolltext") .Activate If .Cells(9, 25).Value > 0 Then .Unprotect Password:="Passwort" .Rows("11:211").Rows.AutoFit ' vielleicht auch nur .Rows("11:211").AutoFit .Range("a11:d211").Locked = False .EnableAutoFilter = True ' Für AutoFilter .Range("B10:D10").Copy Destination:=.Range("B11:D211") .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _ UserInterfaceOnly:=True, Password:="Passwort" End If End With Worksheets(merker).Activate Application.ScreenUpdating = True End Sub

Hallo Reinhard,
mit Deinem Ansatz habe ich eine Lösung gebastelt, die funktioniert:
If Cells(9, 25).Value &gt 0 Then
Worksheets("Protokolltext").Activate
ActiveSheet.Unprotect Password:="Passwort"
ActiveSheet.Range("B10:D10").Copy
ActiveSheet.Range("B11:D211").Select
ActiveSheet.Paste
'Sheets("Protokolltext").Range("B10:D10").Copy Destination:=Sheets("Protokolltext").Range("B11:D211")
ActiveSheet.Rows("11:211").Select
Selection.Rows.AutoFit
ActiveSheet.Range("B11:D211").Select
Selection.Locked = False
ActiveSheet.EnableAutoFilter = True
ActiveSheet.Range("B11:C211").Select
Selection.Locked = True
Selection.FormulaHidden = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
UserInterfaceOnly:=True, Password:="Passwort"
ActiveSheet.Range("D11").Select
End If
Vorstehendes kann vielleicht noch optimiert werden, aber Hauptsache, das Makro läuft.
Danke nochmal
Konni

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread