Nur Rahmen kopieren

Hallo zusammen,
ich habe eine Liste in welcher mit Füllfarbe Bereiche gefüllt und beschriftet werden. Nun ist es so, dass derjenige, der darin arbeitet, manche dieser farbigen Balken mit der Beschriftung darin umher schiebt. Dadurch verschieben sich auch immer die Rahmen, weil er diese mit markiert und nicht die "Einfügeoption nur Formatierung" verwendet, sondern es per Drag and Drop macht.
Nun zu meiner Frage:
Ist es möglich, ein Makro zu verfassen, welches automatisch beim Öffnen der Excel Datei im Hintergrund läuft, die Rahmen im Bereich D5 bis ABS37 löscht und die Rahmen aus der Ursprungsformatierung wieder einfügt. Die bereits befüllten Zellen sollen erhalten bleiben?
Meine Idee war es bisher, die besagten Zellen mit den Rahmen zu kopieren und in einer neuen, ausgeblendeten Tabelle zu hinterlegen. Bei Ausführung des Makros wurde im Bereich die Rahmenlinien komplett gelöscht, dann auf die ausgeblendete Tabelle mit der Ursprungsformatierung gewechselt, diese dann kopiert und auf der eigentlichen Tabelle nur als Formatierung eingefügt. Allerdings verschwinden dann natürlich auch die farbig markierten Zellen und deren Inhalt.
Danke schon mal für die Hilfe.
Excel Datei:
https://www.herber.de/bbs/user/155885.xlsm
Userbild

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Also, ich habe es jetzt mit herumprobieren tatsächlich geschafft ein Makro zu kreieren, was das tut, was ich möchte. Den Code habe ich in der Arbeitsmappe gespeichert, da er mit dem Öffnen der Datei automatisch ausgeführt werden soll. Hierfür habe ich zwei weitere ausgeblendete Tabellen erstellt (Fahrzeuge_Rahmen, Fahrzeuge_Füllung). Mit diesen wir der Inhalt von der Tabelle Fahrzeuge hin und her kopiert. Das alles funktioniert für mich bestens.
Jetzt besteht aber das Problem, sobald ich die Arbeitsmappe freigebe, bekomme ich eine Fehlermeldung und mein kreiertes Makro stoppt mit der Fehlermeldung:
Laufzeitfehler '1004':
Die MergeCells-Eigenschaft des Range-Objekts kann nicht festgelegt werden.
Ich habe nach dem Fehler mal gegoogelt, aber werde nicht so ganz Schlau draus, warum das bei mir nun nicht funktioniert.


Private Sub Workbook_Open()
' Fahrzeug Rahmen Reset
'   Tabellen einblenden
Sheets("Fahrzeuge_Rahmen").Visible = True
Sheets("Fahrzeuge_Füllung").Visible = True
'   Formatierung bei Tabelle "Fahrzeug" zurücksetzten
Sheets("Fahrzeuge").Select
Range("D6:ABS37").Select
Selection.Copy
Sheets("Fahrzeuge_Füllung").Select
Range("A1:ABP32").Select
ActiveSheet.Paste
Sheets("Fahrzeuge_Rahmen").Select
Application.CutCopyMode = False
Range("A1:ABP32").Select
Selection.Copy
Sheets("Fahrzeuge").Select
Range("D6:ABS37").Select
ActiveSheet.Paste
Sheets("Fahrzeuge_Füllung").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Fahrzeuge").Select
Range("D6:ABS37").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'   Schriftart, usw. einstellen
Sheets("Fahrzeuge").Select
Range("D6:ABS37").Select
Selection.Font.Bold = False
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection.Font
.Name = "Arial"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.NumberFormat = "@"
'   Tabellen ausblenden
Sheets("Fahrzeuge_Rahmen").Visible = False
Sheets("Fahrzeuge_Füllung").Visible = False
End Sub

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

4 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Nur Rahmen kopieren

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

4 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread