In anderes Workbook kopieren und Formatierung ändern

[MonkeyS]

Moin,

ich hab eine Workbook A. Jetzt kopiere ich mich einem Makro die Daten von Workbook A in ein Workbook B.
Jetzt möchte ich, dass bestimmte Daten ("K"&"U") jeweils in der neuen Datei geschwärzt sind, bzw. nicht direkt lesbar, aber sichtbar, dass
das Feld belegt ist.

Ich hab ein Makro für das "Schwärzen", kann dies aber nicht in Workbook B einbauen, da diese Datei für alle zugänglich ist und
ich nicht garantieren kann, dass die Benutzer Makros aktiviert haben.

Also müssten die Schwärzung schon vorher stattfinden.


Kann man grob verstehen, was ich meine?

Anbei der Code zum Kopieren

Sub DatenInSammelDatei()

Application.ScreenUpdating = False
Dim wbSammel As Workbook, strSammelPfad As String, strSammelDatei As String
strSammelDatei = "XXXXXXXXXXX"
strSammelPfad = XXXXXXXXXX"

On Error Resume Next
Set wbSammel = Workbooks(strSammelDatei)
 
If wbSammel Is Nothing Then
    Workbooks.Open (strSammelPfad & strSammelDatei)
    Set wbSammel = Workbooks(strSammelDatei)
End If

With ThisWorkbook

    .Sheets("Januar").Range("D1:AI50").Copy wbSammel.Sheets("Januar").Range("D1")
    .Sheets("Februar").Range("D1:AI50").Copy wbSammel.Sheets("Februar").Range("D1")
    .Sheets("März").Range("D1:AI50").Copy wbSammel.Sheets("März").Range("D1")
    .Sheets("April").Range("D1:AI50").Copy wbSammel.Sheets("April").Range("D1")
    .Sheets("Mai").Range("D1:AI50").Copy wbSammel.Sheets("Mai").Range("D1")
    .Sheets("Juni").Range("D1:AI50").Copy wbSammel.Sheets("Juni").Range("D1")
    .Sheets("Juli").Range("D1:AI50").Copy wbSammel.Sheets("Juli").Range("D1")
    .Sheets("August").Range("D1:AI50").Copy wbSammel.Sheets("August").Range("D1")
    .Sheets("September").Range("D1:AI50").Copy wbSammel.Sheets("September").Range("D1")
    .Sheets("Oktober").Range("D1:AI50").Copy wbSammel.Sheets("Oktober").Range("D1")
    .Sheets("November").Range("D1:AI50").Copy wbSammel.Sheets("November").Range("D1")
    .Sheets("Dezember").Range("D1:AI50").Copy wbSammel.Sheets("Dezember").Range("D1")
End With

    wbSammel.Close savechanges:=True

Set wbSammel = Nothing

Application.ScreenUpdating = True
End Sub

Vielen Dank, falls etwas fehlt kurz Bescheid sagen.

Grüße

[Käpt'n Blaubär]

Hallo,

Ich hab ein Makro für das "Schwärzen", kann dies aber nicht in Workbook B einbauen, da diese Datei für alle zugänglich ist und
ich nicht garantieren kann, dass die Benutzer Makros aktiviert haben.

Also müssten die Schwärzung schon vorher stattfinden.

die erste Aussage verstehe ich nicht.

die zweite Aussage: Gegenfrage, wäre eine Schwärzung beim Start der Datei früh genug?
und reicht es nicht, den "wasauchimmer" einmal zu schwärzen? ... und warum überhaupt
schwärzen? Man könnte den ganzen Kram ja auch löschen.

Vielen Dank, falls etwas fehlt kurz Bescheid sagen.

ich bin kein Freund von Salamitaktiken.

[MonkeyS]

Also das Gesamtprojekt ist ein Schichtplan. Und Workbook A ist die Datei in der der Planer die Schichten, Fehlzeiten & Abwesenheiten(Mit Kürzel für den Grund) einträgt.
Workbook B ist die Datei für die Mitarbeiter. Die Mitarbeiter dürfen nur die Schichten sehen und wenn jemand fehlt, aber nicht die Kürzel warum jemand fehlt. (unleserliche Felder)

die erste Aussage verstehe ich nicht.

Also die Datei Workbook B liegt auf einem Server. Da nicht alle Computer aus Sicheitsgründen Makros aktivieren können, muss die Datei schon beim Öffnen ohne Makros, die entsprechenden Felder unleserlich gemacht haben.

Grüße

[Käpt'n Blaubär]

Hallo,

ich habe es immer noch nicht kapiert.
Man kann auch beim Datei schließen diese komische "Schwärzung" ausführen lassen.
Wenn dann die Datei wieder geöffnet wird, dann ist sie eben schon schwarz.

[schauan]

Hallöchen,

das Makro zum Kopieren ist doch in Datei A, oder?

Dann brauchst DU nach dem Kopieren in der Datei B nur noch die Daten in K:U durch xxx ersetzen. Das kann man sogar aufzeichnen:

Code:

Sub Makro1()
'
' Makro1 Makro
'

'
    Range("K6:N12").Select
    Selection.Replace What:="zzz", Replacement:="***", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="yyy", Replacement:="***", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub

Bei Dir könnte das dann für eine Ersetzung so aussehen, musst natürlich den Bereich und das zzz anpassen:

wbSammel.Sheets("Januar").Range("K6:N12").Replace What:="zzz", Replacement:="***", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False