Excel (VBA) farbig Markieren und anschließend kopieren?
Hi liebe Leute, ich benötige bei meiner Excel-Datei eure Hilfe.
Die Datei hat zwei Tabellenblätter "Ermittlung" und "Markierung"
In dem Tabellenblatt "Ermittlung" steht untereinander genaue Zellenpositionen: A4, A1517, A119, A1831 usw. Nun möchte ich, dass dies gerne mittels VBA Makro alle diese Positionen erkennt und auf dem anderen Tabellenblatt "Markierung" farbig markiert.
Dann im nächsten Makro, dass Excel diese farbigen Zeilen kopiert und auf das dritte Tabellenblatt "Prüfung" kopiert. Aber er soll nicht einfach die komplette Zeile kopieren, sondern nur den Bereich Spalte A bis R und genau auch nur in Spalte A bis R diese wieder einfügen.
Gerne seprate in zwei verschiedenen Makros. Ich habe schon gesucht und probiert, aber nichts hat geholfen. Habt Ihr eine Idee? Danke
4 Antworten
Sub einfaerben()
Dim rRef As Range
On Error Resume Next
For Each rRef In Range("A1:A100")
If Not IsEmpty(rRef) Then
Tabelle2.Range(rRef.Value).Interior.Color = vbYellow
End If
Next
On Error GoTo 0
End Sub
Du musst den Bereich A1:A100 noch bei dir auf deine Zellreferenzen anpassen. Auch den Tabellennamen "Tabelle2" musst du noch anpassen.
Erstmal danke für deine Zeit. Leider funktioniert es danach auch nicht. Ich weiß ohne eine Excel-Datei nur an hand der wagen Infos von mir ist da fast unmöglich.
Aber zum Verständnis deiner Programmieren? Woher weiß er denn in welchem Tabellenblatt gesucht und eingefärbt werden soll?
Das Tabellenblatt, auf dem die Schaltfläche liegt ist das, wo die Zelladressen stehen (A1:A100)
Eingefärbt wird in meinem Beispiel auf Tabelle2.
Das Kopieren habe ich vergessen (siehe Oubiy)
Er sucht die komplette Datei ab, wo dann irgendwas von den Werten zwischen A1 und A100 steht? Sorry irgendwie vestehe ich das Prinzip nicht und leider funktioniert es auch nicht. Sorry.
Es kommt noch darauf an, wo du den Code im VBA Editor hinterlegst, d.h. ob in einem Modul oder zu einem Tabellenblatt. Das oben genannte sollte funktionieren, wenn es bei Tabelle1 steht, d.h. wo die Angaben wie A15, A193 stehen.
Ansonsten nur ein Punkt ergänzen:
Sub einfaerben()
Dim rRef As Range
On Error Resume Next
For Each rRef In tabelle1.Range("A1:A100")
If Not IsEmpty(rRef) Then
Tabelle2.Range(rRef.Value).Interior.Color = vbYellow
End If
Next
On Error GoTo 0
End SubEs wird der Bereich A1:A100 auf dieser Tabelle 1 definiert und jede Zelle in diesem Bereich geprüft. Wenn sie nicht leer ist, wird der Inhalt (der ein Zellbezug wie A1, A33 etc.) sein muss, als Adresse für das Färben auf Tabelle2 verwendet.
Wenn deine Zellbezüge nicht in A1:A100 stehen, musst Du das anpassen, ebenso wie die beiden Stellen mit Tabelle1, Tabelle2. Da muss der tatsächliche Namen des Tabellenblatts rein.
Ansonsten macht das Ding das gleiche wie mein Entwurf, ist nur sauberer aufgesetzt von suboptimierer.
so, mit dem Kopieren inklusive könnte das so aussehen:
Sub einfaerben_kopieren()
Dim rRef As Range
On Error Resume Next
For Each rRef In Range("A1:A10")
If Not IsEmpty(rRef) Then
Tabelle2.Range(rRef.Value).Interior.Color = vbYellow
Tabelle2.Range(Tabelle2.Range(rRef.Value), Tabelle2.Range(rRef.Value).Offset(0, 17)).Copy
Tabelle3.Range(rRef.Value).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Next
On Error GoTo 0
End Sub
Vorschlag:
Schalte dem Makro-Recorder ein
führe die benötigten Schritte händisch einmal aus (für die erste Lokalisierung, A4)
Beende die Aufzeichnung
Stelle uns (in einer neuen Antwort) dieses Makro zur Ansicht.
Gruß aus Berlin
So 100%ig klar ist mir das noch nicht.
WO stehen die Zellpositionen denn? Stehen die da als Text?
Angenommen sie stehen in Ermittlungen!A1:A4.
Dann im Modul dieses Tabellenblattes:
Sub Farbig()
Dim Bereich As Range
Dim Zelle As Range
Set Bereich = Range("A1:A4")
With Sheets("Markierungen")
For Each Zelle In Bereich
.Range(Zelle.Value).Interior.ColorIndex = 4
Next Zelle
End With
End Sub
Sub Kopieren()
Dim Zeile As Long
Dim Bereich As Range
Dim Zelle As Range
Set Bereich = Range("A1:A4")
With Sheets("Markierungen")
For Each Zelle In Bereich
Zeile = Zeile + 1
.Range(Zelle.Value).Copy Sheets("Prüfung").Cells(Zeile, 1)
Next Zelle
End With
End Sub
Das kopiert erstmal nur die Zelle aus Spalte A nach Prüfungen.
Leider habe ich jetzt keine Zeit mehr, das auf die Spalten A:R zu erweitern.
Schau erstmal, ob Dir das so schon weiter hilft.
Sonst frage nochmal detailliert nach.
Um die Erweiterung auf mehr Spalten kann ich mir erst morgen kümmern.
Aber vielleicht hilft hier ja auch ein anderer Experte weiter.
Erstmal danke für deine Bemühungen.
Die Zellpositionen stehen in dem Tabellenblatt "Ermittlung" in der Spalte A1:A55
Hierbei zeigt er mir ein Fehler an:
.Range(Zelle.Value).Copy Sheets("Prüfung").Cells(Zeile, 1)Laufzeitfehler 1004: Anwendungs oder objektdefinierter Fehler
Schritt 1, nur um sicherzustellen, dass ich das richtig verstehe:
i = 1
While sheets(1).Cells(i, 1).Value <> ""
Sheets(2).Range(Sheets(1).Cells(i, 1).Value).Interior.Color = vbYellow
i = i + 1
Wend
wenn die Zellangaben (A4,A1517 etc). von A1 bis Axxx stehen
Im Grunde kann man das Markieren doch auch überspringen, oder?
Theoretisch hast du Recht, man könnte diesen Schritt auch überspringen. Denn müssten man die Spalte A:S von dem Tabellenblatt "Markierung" , unter berücksichtigung der erforderlichen Zeilen, die sich bei dem Tabellenblatt "Ermittlung" befinden, in das Tabellenblatt "Prüfung" ebendfalls in dem Bereich A:S reinkopieren.
Klingt das verständlich? Danke dir.
Bei deinem VBA sagt er mir das ein Objekt erforderlich ist. Sheets hatte ich zuvor schon angepasst.
ich hab die Variante inkl. Kopieren bei Suboptimierers Antwort als Kommentar ergänzt, weil mir sein Ansatz als Basis besser gefällt
Kannst du mir das erläutern? Da tut sich nichts bei mir.