|
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
 Daten kopieren und Formatierung ändern |
20.02.2018 13:11:32 |
Monkey |
|
|
|
20.02.2018 13:12:40 |
Gast73837 |
|
|
|
20.02.2018 13:29:08 |
RPP63 |
|
|
|
20.02.2018 13:58:23 |
Gast36654 |
|
|
|
20.02.2018 16:57:06 |
Gast70117 |
|
|
Von:
Monkey |
Datum:
20.02.2018 13:11:32 |
Views:
1054 |
Rating:
|
Antwort:
|
Thema:
Daten kopieren und Formatierung ändern |
|
Moin,
ich habe ein Makro, mit dem ich die Daten meiner 1sten Workbook in ein 2tes kopiere.
Jetzt möchte ich das während des Kopierens bestimmte Daten "geschwärzt" werden.
Die Daten die dort gespeichert sind bestehen aus bestimmten Buchstaben Kombinationen. Wenn ich jetzt
das Marko aktiviere möchte ich, dass jede Zelle die "K" enthält nur farblich ohne Inhalt kopiert wird.
Und in der zweiten Tabelle dann statt dem "K" ein blau formatiertes Feld erscheint.
Ich kann die "schwärzungs" Funktion nicht in die zweite Tabelle schreiben, da dort nicht sichergestellt ist, dass der User Makros aktiviert hat.
Ich hoffe ihr habt verstanden, was ich vor habe und könnt mir helfen.
Grüßé
Monkey
Anbei der Kopiercode.
Sub DatenInSammelDatei()
Application.ScreenUpdating = False
Dim wbSammel As Workbook, strSammelPfad As String, strSammelDatei As String
strSammelDatei = "XXXXXXXXXXXX"
strSammelPfad = "XXXXXXXXXX"
On Error Resume Next
Set wbSammel = Workbooks(strSammelDatei)
'wenn nicht geöffnet, öffnet sie
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")
wbSammel.Close savechanges:=True
Set wbSammel = Nothing
Application.ScreenUpdating = True
End Sub |
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
|
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
Daten kopieren und Formatierung ändern |
20.02.2018 13:11:32 |
Monkey |
|
|
|
20.02.2018 13:12:40 |
Gast73837 |
|
|
|
20.02.2018 13:29:08 |
RPP63 |
|
|
|
20.02.2018 13:58:23 |
Gast36654 |
|
|
|
20.02.2018 16:57:06 |
Gast70117 |
|
|