ich bin benötig ein Makro, welches bestimmte Zellen aus einer Zeile in ein anderes Registerblatt kopiert, nur wenn in Spalte F oder Spalte G ein "X" steht
Wenn nach dem Ausführen des Markros neue Zeilen im Registerblatt "Daten" mit "X" gekennzeichnet werden, soll die neue Zeile unten angehängt werden und die schon übernommenen Werte nicht angetastet werden (zweites Makro). Maximale auszulesende Zeilen sind 100.
Ich sag schon mal Danke für eure Anregungen. Lines
wer fragt, gilt vielleicht für den Augenblick als dumm... ...wer nicht fragt bleibt es sein Leben lang!
(04.05.2023, 11:16)Lines schrieb: Ich sag schon mal Danke für eure Anregungen.
"Anregungen", nein Komplettlösungen, findet man zu diesem ausgelatschten Thema doch zuhauf im Netz. Es klingt daher eher, du erwartest eine Komplettlösung. Also: Warum bist du nicht ehrlich und fragst nach einer Komplettlösung?
Zitat:wer fragt, gilt [...] als dumm...
"faul" ist korrekt. Was meinst du, was man erst lernen kann, wenn man anfängt, sowas selbst hinzubekommen?
Für Code 2, wobei ich Code 1 für sinnlos erachte, du wirst dahinterkommen.
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range) Dim out As Worksheet: Set out = Worksheets("Auswertung") Dim lngNewRow As Long Dim c As Range
If Not Intersect(Target, Me.Range("F:G")) Is Nothing Then For Each c In Intersect(Target, Me.Range("F:G")) If LCase(c.Value) = "x" Then If IsError(Application.Match(Me.Cells(c.Row, 1).Value, out.Range("A:A"), 0)) Then With out lngNewRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 .Cells(lngNewRow, 1).Value = Me.Cells(c.Row, 1).Value .Cells(lngNewRow, 2).Value = Me.Cells(c.Row, 2).Value .Cells(lngNewRow, 3).Value = Me.Cells(c.Row, 3).Value .Cells(lngNewRow, 4).Value = Me.Cells(c.Row, 8).Value End With End If End If Next c End If End Sub
Folgende(r) 1 Nutzer sagt Danke an Gast für diesen Beitrag:1 Nutzer sagt Danke an Gast für diesen Beitrag 28 • Stephan
(04.05.2023, 11:42)EarlFred schrieb: "Anregungen", nein Komplettlösungen, findet man zu diesem ausgelatschten Thema doch zuhauf im Netz. Es klingt daher eher, du erwartest eine Komplettlösung. Also: Warum bist du nicht ehrlich und fragst nach einer Komplettlösung?
"faul" ist korrekt. Was meinst du, was man erst lernen kann, wenn man anfängt, sowas selbst hinzubekommen?
Für Code 2, wobei ich Code 1 für sinnlos erachte, du wirst dahinterkommen.
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range) Dim out As Worksheet: Set out = Worksheets("Auswertung") Dim lngNewRow As Long Dim c As Range
If Not Intersect(Target, Me.Range("F:G")) Is Nothing Then For Each c In Intersect(Target, Me.Range("F:G")) If LCase(c.Value) = "x" Then If IsError(Application.Match(Me.Cells(c.Row, 1).Value, out.Range("A:A"), 0)) Then With out lngNewRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 .Cells(lngNewRow, 1).Value = Me.Cells(c.Row, 1).Value .Cells(lngNewRow, 2).Value = Me.Cells(c.Row, 2).Value .Cells(lngNewRow, 3).Value = Me.Cells(c.Row, 3).Value .Cells(lngNewRow, 4).Value = Me.Cells(c.Row, 8).Value End With End If End If Next c End If End Sub
Hallo EarlFred,
du hast völlig recht, ich bin zu sehr im Stress um Anregungen umzusetzen und möchte eine Lösung. Ich schau mir nachher an was du vorgeschlagen hast. Danke
wer fragt, gilt vielleicht für den Augenblick als dumm... ...wer nicht fragt bleibt es sein Leben lang!
Kommt ein Kollege zu mir mit einem Excelproblem. Ich "hab ich auch keine Ahnung, kenne aber ein Forum in dem ich fragen kann"... Fehler von mir das ich dachte es sei der Sinn dieses (jedes?) Forums nach Hilfe zu fragen wenn man keine Ahnung von einem Thema hat. Ich hab beruflich nicht die Zeit mich hinzusetzen und VBA/Query und co. zu lernen, meine Kompetenzen liegen woanders. Ergebnis: Blöd angemacht wurden mit einer (bei mir?) nicht funktionierenden Lösung und einem freundlichen Hinweis auf Query (Dafür Danke PIVPQ) per PN. Hilfsspalte und Autofilter kommen nicht in Frage.
Hat noch jemand eine sachliche Lösung für mich?
wer fragt, gilt vielleicht für den Augenblick als dumm... ...wer nicht fragt bleibt es sein Leben lang!
Forum = Kostenloser Programmierservice? Ist das dein Ernst? Falsch gedacht! Ich kann nicht mit einer Bohrmaschine umgehen? Frag ich doch in einem Forum, da kommt dann einer zu mir und werkelt kostenlos? Sag mal: Gehts noch? Schuss nicht gehört?
Und dann bekommst du eine funktionierende Lösung, heulst aber rum, dass du böse behandelt wirst und außer der Lüge, es funktioniere alles nicht, bekommt man keine verwertbare Aussage? Ich bereue es, mich mit deinem Problem beschäftigt zu haben! Wa für eine verabscheuenswürdige und widerwärtige Anspruchshaltung, was bist du für ein Mensch, für den selbst kostenlos noch zu teuer ist? Scher dich zum Teufel!
also der VBA-Code von EarlFred funktioniert bei mir in deiner Beispieldatei perfekt. (Wie) hast du den Code ausprobiert ? Wo hast du ihn eingefügt ? Das ist ein Ereignismakro, das durch Änderungen im jeweiligen Tabellenblatt ausgelöst wird und gehört in das Codemodul von Tabellenblatt "Daten". (Rechtsklick auf Tabellenblattregister "Daten" -> Code anzeigen) https://www.online-excel.de/excel/singsel_vba.php?f=44 Wenn in Spalte F oder G ein x eingetragen wird, werden die Werte dieser Zeile automatisch in das Tabellenblatt "Auswertung" übertragen.
Eine weitere Anregung: verwende eine Formellösung. in neueren Excelversionen (Excel 2021, Office 365) gäbe es hierfür die Funktion FILTER. In älteren Excelversionen geht es (etwas aufwendiger) mit der INDEX/AGGREGAT-Formel Erklärung der Formel siehe hier: https://www.youtube.com/watch?v=He3dblboncw
Makro Daten übertragen
![[-]](https://www.clever-excel-forum.de/images/collapse.png)
und einem freundlichen Hinweis auf Query (Dafür Danke PIVPQ) per PN.