kolom grootte ook mee kopieren

[ferdibulk]

Ik heb nu deze code

Option Explicit
Sub opslaan()

Range("A1:C150").Select
Selection.Copy
Sheets("Sheet1").Select
Sheets.Add(After:=Worksheets(ActiveSheet.Index)) _
.Name = "Systeem " & Worksheets("sheet1").Range("C1").Value
Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("C1, B7:C150 ").Select
Range("C1").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("C1").Select

End Sub

dit op een sheet als extra worksheet op te slaan. maar nu wil ik ook de kolomgrootte mee nemen omdat die deze weer veranderd. nu dacht ik aan deze

Option Explicit
Sub opslaan()

Range("A1:C150").Select
Selection.Copy
Sheets("Sheet1").Select
Sheets.Add(After:=Worksheets(ActiveSheet.Index)) _
.Name = "Systeem " & Worksheets("sheet1").Range("C1").Value
Range("A1").Select
ActiveSheet.PasteSpecial Paste:=xlFormats
Sheets("Sheet1").Select
Range("C1, B7:C150 ").Select
Range("C1").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("C1").Select

End Sub

maar deze werkt niet zo

 

[ferdibulk]

Ik heb hem al


Option Explicit
Sub opslaan()

Range("A1:C150").Select
Selection.Copy
Sheets("Checklist").Select
Sheets.Add(After:=Worksheets(ActiveSheet.Index)) _
.Name = "Systeem " & Worksheets("Checklist").Range("C1").Value
ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("C1").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Checklist").Select
Range("C1, B7:C150 ").Select
Range("C1").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("C1").Select

End Sub

dit moet hem zijn dan

 

[Warme bakkertje]

Als je nu nog al die Select, Selection en Activate uit je code werkt is hij helemaal net echt

Mvg

Rudi