Spalten kopieren mit Schreibschutz

Forumthread: Spalten kopieren mit Schreibschutz

18.06.2016 21:12:07

Markus

Liebes Forum,
wie kann ich, nachdem ich die ausgewählten Spalten in die "Ziel"-Tabelle rüber kopiert habe, einen bestimmten Bereich ( Spalte B bis E) sperren (Schreibschutz)? Die Spalten A und F sollen weiter bearbeitet werden können. Zudem müsste sich dieser Schreibschutz bei jedem Übertragen der Spalten während des Kopiervorgangs aufheben und anschließend wieder aktiv sein.

Sub kopieren ()
Dim StDatei As String
StDatei = "Quelle_" & Format(Date, "dd.mm")
Workbooks(StDatei &".xlsm").Worksheets("Tabelle1").Range("A1:A30").Copy
With Workbooks("Ziel.xlsm").Worksheets("Tabelle1").Range("A1")
.PasteSpecial Paste :=xlValues
.PasteSpecial Paste:=xlFormats
End With
Applications.CutCopyMode=False
Workbooks(StDatei &".xlsm").Worksheets("Tabelle1").Range("B1:E30").Copy
With Workbooks("Ziel.xlsm").Worksheets("Tabelle1").Range("B1")
.PasteSpecial Paste :=xlValues
.PasteSpecial Paste:=xlFormats
End With
Applications.CutCopyMode=False
Workbooks(StDatei &".xlsm").Worksheets("Tabelle1").Range("F1:F30").Copy
With Workbooks("Ziel.xlsm").Worksheets("Tabelle1").Range("F1")
.PasteSpecial Paste :=xlValues
.PasteSpecial Paste:=xlFormats
End With
Applications.CutCopyMode=False
End Sub

Vielen Dank!

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Spalten kopieren mit Schreibschutz

19.06.2016 19:09:52

Michael
AW: Spalten kopieren mit Schreibschutz

19.06.2016 20:52:45

Markus
freut mich, Gruß zurück owT

19.06.2016 21:46:06

Michael

AW: Spalten kopieren mit Schreibschutz

19.06.2016 19:09:52

Michael

Hi Markus,
z.B. so:

Option Explicit
Sub kopieren()
Dim zSh As Worksheet ' z wie Ziel
Dim StDatei As String
StDatei = "Quelle_" & Format(Date, "dd.mm")
'   Set zSh = Workbooks("Ziel.xlsm").Worksheets("Tabelle1")
Set zSh = ActiveWorkbook.Worksheets("Tabelle1")
zSh.Unprotect
'   Workbooks(StDatei & ".xlsm").Worksheets("Tabelle1").Range("A1:F30").Copy
Worksheets("Tabelle2").Range("A1:F30").Copy
With zSh.Range("A1")
.PasteSpecial Paste:=xlValues
.PasteSpecial Paste:=xlFormats
End With
Application.CutCopyMode = False
zSh.Range("A1:A30").Locked = False
zSh.Range("B1:E30").Locked = True
zSh.Range("F1:F30").Locked = False
zSh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
zSh.EnableSelection = xlUnlockedCells
End Sub

Ich habe die drei Kopieraktionen auf eine zusammengedampft; sollte es sich tatsächlich um nicht zusammenhängende Bereiche handeln, mußt es halt wieder auseinanderdröseln.
Schöne Grüße,
Michael

AW: Spalten kopieren mit Schreibschutz

19.06.2016 20:52:45

Markus

Hallo Michael,
funktioniert perfekt - Dankeschön!

freut mich, Gruß zurück owT

19.06.2016 21:46:06

Michael

Beliebteste Forumthreads (12 Monate)

Spalten kopieren mit Schreibschutz

Forumthread: Spalten kopieren mit Schreibschutz

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread