Zellensperre beim Blattkopieren mitkopieren?

[Butch]

Hallo!

Ich kopiere per Makro Bereiche aus einem Blatt in ein anderes Blatt, z.B. so:

Code: Alles auswählen

    Sheets("Muster").Select
    Application.CutCopyMode = False
    Columns("A:A").Select
    Selection.Copy

    Sheets("Januar").Select
        Call Schaltfl_loeschen
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select

Die Zellensperre im Ausgangsblatt wird dabei nicht mitkopiert. Gibt es dafür eine einfache Lösung? Danke im Voraus!

[Mondblatt24]

Hallo,
Fragen zu Makros sollten im Bereich LibreOffice Programmierung gestellt werden.

[craig]

Hallo,

ich wünsche Euch allen frohe Weihnachten!

@Butch:
Bitte beachte für das nächste Mal Peters Hinweis.

Selektieren ist in den meisten Fällen der Progammierung nicht erforderlich,
man kennt ja in der Regel den Quell- und Zielbereich.
https://www.online-excel.de/excel/singsel_vba.php?f=78
Naja, auch hier: Ausnahmen bestätigen die Regel.

Ein Beispielcode:
Ich weiß aber nicht, ob er auch gesperrte Zelle mitkopiert.
Ggf. muss das Makro dann in der Weise erweitert werden, dass der Blattschutz
erst aufgehoben wird und nach dem Ablauf wieder neugesetzt wird.

Code: Alles auswählen

REM  *****  BASIC  *****
Option Explicit

REM ════════════════════════════════════════════════════════════════════════════════════════════════════
REM					CALC: Kopieren ohne Selektion, inklusive aller Formatierungen
REM
REM	https://wiki.openoffice.org/wiki/Documentation/BASIC_Guide/Cells_and_Ranges
REM 
REM 1)	[Zellbereich kopieren]
REM 
REM ════════════════════════════════════════════════════════════════════════════════════════════════════

Sub [Zellbereich kopieren]
Dim oDoc As Object
Dim oSheet As Object
Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
Dim CellAddress As New com.sun.star.table.CellAddress
 
	oDoc=ThisComponent
		oSheet=oDoc.Sheets.getbyindex(0)

REM --------------------------------------------------------------------------------- 
REM festlegen des Quellberreichs
CellRangeAddress.Sheet = 0				' Referenz: erstes Tabellenblatt Index=0
CellRangeAddress.StartColumn = 0		' Referenz: Start	→ Spalte A
CellRangeAddress.StartRow = 0			' Referenz: Start	→ Zeile 1
CellRangeAddress.EndColumn = 0			' Referenz: Ende	→ Spalte A
CellRangeAddress.EndRow = 500			' Referenz: Ende	→ letzte Zeile

REM ---------------------------------------------------------------------------------
REM festlegen des Zielberreichs
CellAddress.Sheet = 0					' Referenz: erstes Tabellenblatt Index=0
CellAddress.Column = 2					' Referenz: Ziel	→ Spalte C
CellAddress.Row = 0						' Referenz: Ziel	→ Zeile 1


REM ---------------------------------------------------------------------------------
REM Quellbereich in Zielbereich kopieren
			oSheet.copyRange(CellAddress, CellRangeAddress)
End Sub

Beachte die Kommentare im Code.

Noch ein Hinweis:

Code: Alles auswählen

Columns("A:A").Select

Mit dieser Anweisung markierst Du die gesamte Spalte A, also mehr als 1 Millionen Zellen.
Das könnte sich als erheblich Systembremse auswirken.
In meinem Beispiel habe ich nur 501 (0-500) Zeilen referenziert, wenn Du mehr
Zeilen kopieren möchtest, dann erhöhe diesen Wert.
Achte hierbei darauf, dass der Index für Spalten- und Zeilenzähler immer bei 0 beginnt.

Zeile 1 = 0
Zeile 2 = 1
usw.

Spalte A = 0
Spalte B = 1
Spalte C = 2
usw.

Teste den Code erst in einem Beispieldokument.

Wenn Du den Zellbereich in ein anderes Blatt kopieren möchtest,
dann benötigst Du diesen Code:

Code: Alles auswählen

REM  *****  BASIC  *****
Option Explicit

REM ════════════════════════════════════════════════════════════════════════════════════════════════════
REM					CALC: Kopieren ohne Selektion, inklusive aller Formatierungen
REM
REM	https://wiki.openoffice.org/wiki/Documentation/BASIC_Guide/Cells_and_Ranges
REM 
REM 1)	[Zellbereich kopieren]
REM 
REM ════════════════════════════════════════════════════════════════════════════════════════════════════

Sub [Zellbereich kopieren]
Dim oDoc As Object
Dim oSheet As Object
Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
Dim CellAddress As New com.sun.star.table.CellAddress
 
	oDoc=ThisComponent
		oSheet=oDoc.Sheets.getbyindex(0)

REM --------------------------------------------------------------------------------- 
REM festlegen des Quellberreichs
CellRangeAddress.Sheet = 0				' Referenz: erstes Tabellenblatt Index=0
CellRangeAddress.StartColumn = 0		' Referenz: Start	→ Spalte A
CellRangeAddress.StartRow = 0			' Referenz: Start	→ Zeile 1
CellRangeAddress.EndColumn = 0			' Referenz: Ende	→ Spalte A
CellRangeAddress.EndRow = 500			' Referenz: Ende	→ letzte Zeile

REM ---------------------------------------------------------------------------------
REM festlegen des Zielberreichs
CellAddress.Sheet = 0					' Referenz: erstes Tabellenblatt Index=0
CellAddress.Column = 2					' Referenz: Ziel	→ Spalte C
CellAddress.Row = 0						' Referenz: Ziel	→ Zeile 1


REM ---------------------------------------------------------------------------------
REM Quellbereich in Zielbereich kopieren
			oSheet.copyRange(CellAddress, CellRangeAddress)
End Sub


REM  *****  BASIC  *****
Option Explicit

REM ════════════════════════════════════════════════════════════════════════════════════════════════════
REM					CALC: Kopieren ohne Selektion, inklusive aller Formatierungen
REM
REM	https://wiki.openoffice.org/wiki/Documentation/BASIC_Guide/Cells_and_Ranges
REM 
REM 1)	[Zellbereich kopieren]
REM 
REM ════════════════════════════════════════════════════════════════════════════════════════════════════

Sub [Zellbereich kopieren]
Dim oDoc As Object
Dim oSheet1 As Object
Dim oSheet1 As Object

Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
Dim CellAddress As New com.sun.star.table.CellAddress
 
	oDoc=ThisComponent

REM --------------------------------------------------------------------------------- 
REM Hier ggf. die Blattnamen anpassen
		oSheet1=oDoc.Sheets.getbyName("Tabelle1")
			oSheet2=oDoc.Sheets.getbyName("Tabelle2")

REM --------------------------------------------------------------------------------- 
REM festlegen des Quellbereichs der "Tabelle1"
REM !!!
REM Hier ggf. CellAddress.Sheet = 1 anpassen
REM z.B.: CellAddress.Sheet = 5 anpassen
CellRangeAddress.Sheet = 0				' Referenz: erstes Tabellenblatt Index=0
CellRangeAddress.StartColumn = 0		' Referenz: Start	→ Spalte A
CellRangeAddress.StartRow = 0			' Referenz: Start	→ Zeile 1
CellRangeAddress.EndColumn = 0			' Referenz: Ende	→ Spalte A
CellRangeAddress.EndRow = 500			' Referenz: Ende	→ letzte Zeile

REM ---------------------------------------------------------------------------------
REM festlegen des Zielberreichs der "Tabelle2"
REM !!!
REM Hier ggf. CellAddress.Sheet = 1 anpassen
REM z.B.: CellAddress.Sheet = 5 anpassen
CellAddress.Sheet = 1					' Referenz: zweites Tabellenblatt Index=0
CellAddress.Column = 2					' Referenz: Ziel	→ Spalte C
CellAddress.Row = 0						' Referenz: Ziel	→ Zeile 1


REM ---------------------------------------------------------------------------------
REM Quellbereich in Zielbereich des zweiten Tabellenblattes kopieren
			oSheet2.copyRange(CellAddress, CellRangeAddress)
End Sub

Achte unbedingt auf die Kommentare im Code!
Da ich Dein Dokument nicht kenne, musst ggf. den Code selber anpassen

Falls Du Schwierigkeiten hast, dann erstelle ein Musterdokument und lade es hier hoch.

[F3K Total]

Moin,
der Befehl, mit dem craig den Zellbereich von einem ins andere Tabellenblatt kopiert, lautet

Code: Alles auswählen

.CopyRange()

Ich habe es ausprobiert, kann bestätigen, dass der Zellschutz mitkopiert wird.
Hier mein kurzes Testmakro, bei dem der Tabelleschutz, wenn vorhanden, entfernt, damit das Kopieren möglich ist, und danach wieder gesetzt wird.

Code: Alles auswählen

Sub copy_cellrange
    oSheets = ThisComponent.Sheets
    oSourceSheet = oSheets.getbyName("Muster")
    oTargetSheet = oSheets.getbyName("Januar")
    if oSourceSheet.isprotected then
        bSourceProtected = true
        oSourceSheet.unprotect("")
    endif
    if oTargetSheet.isprotected then
        bTargetProtected = true
        oTargetSheet.unprotect("") 
    endif       
    oColumnA = oSourceSheet.Columns.getbyName("A")
    oSourceSheet.copyRange( oTargetSheet.getcellbyPosition(0,0).CellAddress, oColumnA.RangeAddress)
    if bSourceProtected then oSourceSheet.protect("")
    if bTargetProtected then oTargetSheet.protect("")
End Sub

Sollten die Blätter mit einem Passwort geschütz sein, muss das Passwort hier angegeben werden:

Code: Alles auswählen

oSourceSheet.unprotect("Passwort")
oSourceSheet.protect("Passwort")
oTargetSheet.unprotect("Passwort")
oTargetSheet.protect("Passwort")

Gruß R