Ich hoffe jemand kann mir weiterhelfen. Wenn ich diesen Code laufen lasse verschwinden mehrere Comboboxen. Switche ich kurz in eine andere Tabelle und wieder zurück sind die Comboboxen wieder sichtbar. Finde nicht raus warum dem so ist.
Liebe Gruess
Richi
Sub Infos_Löschen_Kopieren_einfügen()
Dim Passwort As String
' Passwort eingeben
Passwort = "xxxxxxxxxxxxx" ' Dein Passwort hier
'--------------------------Startblock zur Geschwindigkeitserhöhung bei Schleifen------------------------
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
' Schleife durch alle Arbeitsblätter in der aktuellen Arbeitsmappe
For Each ws In ThisWorkbook.Worksheets
' Blattschutz aufheben
On Error Resume Next ' Fehler ignorieren
ws.UNPROTECT Passwort
On Error GoTo 0 ' Fehlerbehandlung wieder aktivieren
Next ws
'
' Infos_Löschen_Kopieren_Einfügen Makro
'
Sheets("Single Line View").Select 'Kommentare löschen in Range
Range("C7:PB121").Select
Selection.ClearComments
Range("C7").Select
Sheets("Single Line View").Select
Range("C255:PB369").Select 'Selektieren des zu kopierenden Ranges
Selection.Copy
Sheets("Single Line View").Select
Range("C503").Select 'Kopierter Range einfügen ab Zelle
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C7").Select 'Auf Zelle springen
'
'In Range pro Zelle Info einfügen
'
Dim rng As Range
For Each rng In ThisWorkbook.Worksheets("Single Line View").Range("B503:PB617").SpecialCells( _
xlCellTypeConstants) 'Range der zu kopieren ist und als Kommentar hinterlegt weden soll
If rng > "" Then
With Worksheets("Single Line View").Range(rng.Offset(-496, 0).Address)
.ClearComments
.AddComment
.Comment.Visible = False
.Comment.Text Text:=CStr(rng)
.Comment.Shape.TextFrame.AutoSize = True 'Offset definiert den Start des einzufügenden Kommentars
End With
End If
Next rng
' Schleife durch alle Arbeitsblätter in der aktuellen Arbeitsmappe
For Each ws In ThisWorkbook.Worksheets
' Blattschutz aktivieren
On Error Resume Next ' Fehler ignorieren
ws.PROTECT Passwort
On Error GoTo 0 ' Fehlerbehandlung wieder aktivieren
Next ws
'------------------------------------Endblock zur Geschwindigkeitserhöhung bei Schleifen------------------------------------
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub