Zelle finden, Zeile kopieren in neue Tabelle

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Public Sub Verteilen() Dim i As Long, loLetzte As Long, strBlatt As String Dim wsQuelle As Worksheet Set wsQuelle = ThisWorkbook.Worksheets("MAT-Anfo (AB)") Application.ScreenUpdating = False 'Prüfen ob Auswahl mit X getroffen wurde If WorksheetFunction.CountIf(wsQuelle.Range("C5:H5"), "X") = 0 Then MsgBox "Es wurde keine Auswahlt in C5 bis H5 getroffen." Exit Sub Else For i = 3 To 8 If UCase(wsQuelle.Cells(5, i)) = "X" Then strBlatt = wsQuelle.Cells(4, i) With Worksheets(strBlatt) 'Prüfen ob im Zielblatt der Datensatz schon vorhanden ist If WorksheetFunction.CountIf(.Columns(2), wsQuelle.Range("I5")) = 0 Then loLetzte = .Cells(.Rows.Count, 2).End(xlUp).Offset(1).Row wsQuelle.Range("I5:M5").Copy .Cells(loLetzte, 2).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False Else MsgBox "Der Datensatz mit der P/N " & wsQuelle.Range("I5") & " wurde nicht" _ & vbLf _ & "ins Blatt " & strBlatt & " übertragen." & vbLf _ & "Diese P/N ist dort schon vorhanden." End If End With End If Next i wsQuelle.Range("C5:O5").ClearContents End If Set wsQuelle = Nothing End Sub

Sub Weiterzaehlen() If Sheets("MAT-Anfo (AB)").Range("C5") = "" And Sheets("MAT-Anfo (AB)").Range("D5") = "" And _ Sheets("MAT-Anfo (AB)").Range("E5") = "" And Sheets("MAT-Anfo (AB)").Range("F5") = "" And Sheets("MAT-Anfo (AB)").Range("G5") = "" And Sheets("MAT-Anfo (AB)").Range("H5") = "" And Sheets("MAT-Anfo (AB)").Range("I5") = "" And Sheets("MAT-Anfo (AB)").Range("J5") = "" And Sheets("MAT-Anfo (AB)").Range("K5") = "" And Sheets("MAT-Anfo (AB)").Range("L5") = "" And Sheets("MAT-Anfo (AB)").Range("M5") = "" And Sheets("MAT-Anfo (AB)").Range("N5") = "" And Sheets("MAT-Anfo (AB)").Range("O5") = "" Then MsgBox "No Data entered" Exit Sub Else Application.ScreenUpdating = False Dim KundenNummer As Long Dim Zeile As Long Sheets("MasterList-Neu").Select With ActiveSheet 'Verweis auf das Tabellenblatt, auf dem alles stattfindet 'erste freie Zeile suchen: Zeile = .Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1 'In Spalte A die größte Nummer suchen und 1 addieren KundenNummer = Application.WorksheetFunction.Max(.Columns(1)) + 1 'zur Zelle springen und neue Kundennummer eintragen: .Cells(Zeile, 1).Value = KundenNummer Application.Goto .Cells(Zeile, 1) End With Sheets("MAT-Anfo (AB)").Range("C5:O5").Copy Sheets("MasterList-Neu").Select Dim str1 As String Dim str2 As String Range("A65536").End(xlUp).Activate ActiveCell.Offset(0, 1).PasteSpecial Range("A1").Select Sheets("MAT-Anfo (AB)").Range("C5:O5").ClearContents Sheets("MAT-Anfo (AB)").Select Range("A1").Select MsgBox "Data successfully transferred to the Master List" End If End Sub

Option Explicit Public Sub Verteilen() Dim i As Long, loLetzte As Long, strBlatt As String Dim wsQuelle As Worksheet, boVorhanden As Boolean Set wsQuelle = ThisWorkbook.Worksheets("MAT-Anfo (AB)") Application.ScreenUpdating = False If WorksheetFunction.CountIf(wsQuelle.Range("C5:H5"), "X") > 0 Then With Worksheets("MasterList-Neu") If WorksheetFunction.CountIf(.Columns(8), wsQuelle.Range("I5")) = 0 Then boVorhanden = True loLetzte = .Cells(.Rows.Count, 8).End(xlUp).Offset(1).Row .Cells(loLetzte, 1) = WorksheetFunction.Max(.Columns(1)) + 1 wsQuelle.Range("C5:O5").Copy .Cells(loLetzte, 2).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False Else MsgBox "Der Datensatz mit der P/N " & wsQuelle.Range("I5") & " wurde nicht" _ & vbLf & "ins Blatt MasterList-Neu übertragen." & vbLf _ & "Diese P/N ist dort schon vorhanden." End If End With For i = 3 To 8 If UCase(wsQuelle.Cells(5, i)) = "X" Then strBlatt = wsQuelle.Cells(4, i) With Worksheets(strBlatt) If WorksheetFunction.CountIf(.Columns(2), wsQuelle.Range("I5")) = 0 Then boVorhanden = True loLetzte = .Cells(.Rows.Count, 2).End(xlUp).Offset(1).Row wsQuelle.Range("I5:M5").Copy .Cells(loLetzte, 2).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False Else MsgBox "Der Datensatz mit der P/N " & wsQuelle.Range("I5") _ & " wurde nicht" & vbLf & "ins Blatt " & strBlatt & " übertragen." _ & vbLf & "Diese P/N ist dort schon vorhanden." End If End With End If Next i Else MsgBox "Es wurde keine Auswahl in C5 bis H5 getroffen." End If If boVorhanden Then wsQuelle.Range("C5:O5").ClearContents Set wsQuelle = Nothing End Sub

Hallo Werner,
Hier mein versprochenes Feedback:
Deine Zusammenführung der zwei Makros funktioniert super !!!
Ich habe hier und da noch ein paar Anpassungen vorgenommen und das Ganze läuft perfekt!
Ein super großes Dankeschön !!!
P/S: Auch kann ich durch Deine Vorschläge echt zulernen - geht man genauer ins Detail erkennt man den Unterschied zwischen "Profi" und "Azubi" :-)
Nun traue ich mich kaum noch zu fragen, aber es gibt noch ein Problem:
Die "MasterList-Neu" beinhaltet alle Materialanforderungen. Entsprechend der gesetzten "X" im Bereich "C5:H5", Sheets("MAT-Anfo (AB)"), werden die Datensätze auf unterschiedlichste Listen verteilt - so weit, so gut.
In der "MasterList-Neu" kann ich Datensätze durchstreichen (Wunsch meiner Kollegen), bzw. ganz löschen. Dies läuft dort über Abfrage nach der "Laufenden Nummer" und funktioniert recht gut.
Aber ...
Werden Datensätze durchgestrichen, bzw. gelöscht, sind die anderen Listen nicht involviert. Das heißt, die Daten dort bleiben unberührt.
Da die "MasterList-Neu" das Löschen oder Durchstreichen der Daten über "Laufende Nummer" anstößt und die anderen Listen keine "Laufende Nummer" haben, finde ich keinen einfachen Weg, die Daten in den Listen mit einzubeziehen. Selbst wenn die Listen eine "Laufende Nummer" hätten, wären diese seltenst identisch zur "MasterList-Neu".
Ich könnte mir vorstellen, in den Listen nach der P/N zu suchen um dort dann durchzustreichen oder zu löschen. Wird gelöscht, müssten die Daten "aufrücken".
Hättest Du dazu noch eine Idee?
Ich sende Dir, wenn Du es möchtest, gern das gesamte Tool noch einmal zu - wenn es für Dich einfacher wäre, auch gern mit allen aktiven Makros. So könntest Du direkt "hinter die Kulissen" schauen.
Das war das letzte Mal, dass ich nerve - versprochen. Und sollte es für Dich nicht möglich sein darüber zu schauen ... absolut kein Problem !!! Du hast mir so schon unheimlich geholfen!
Danke & Gruss aus Hamburg
Frank

Guten Morgen Werner,
Bitte entschuldige meine späte Antwort - ich sprang gestern noch von Meeting zu Meeting und hatte kaum noch Zeit für das "kleine Tool" und um Dir zu antworten - und heute früh ging's mit den Meetings gleich weiter. Sorry ...
Also, zu Deiner Erklärung (in wenigen Worten):
Wir modifizieren Flugzeuge oder bauen diese komplett um - nach den Wünschen unterschiedlichster Airlines. Dazu erarbeitet das Ingenieurs-Team, wozu ich gehöre, u.a. einen Material-Plan, welcher das für die Modifikation benötigte Material aufzeigt. Bestellt und organisiert wird das MAT dann durch unseren Bereich Logistik.
Bisher wurden diese MAT-Anforderungen immer telefonisch an die Logistik weitergegeben ... war nicht der beste Weg, aus unterschiedlichsten Gründen. Darum möchte ich nun ein kleines Tool schaffen, welches von beiden Seiten einzusehen ist, also auf einem gemeinsamen Laufwerk liegt, welches unsere Anforderung mit entsprechender Reaktion der Logistik widerspiegelt und welches das Ganze auch irgendwie festhält - sprich, in Form einer "Bestell-Tabelle".
Da wir oft zur gleichen Zeit mehrere Flugzeuge bearbeiten, wäre dieses Tool jeweils für ein "Projekt" gedacht - es wird also so sein, dass zwei/drei dieser "Tools" zur gleichen Zeit aktiv genutzt werden.
Reiter "Deckblatt":
Soll immer als Startseite öffnen (Makro nötig) und Symbolleisten, Bearbeitungsleisten und Gitternetzlinien sollen beim Öffnen verschwinden - um eigenständige Änderungen zu vermeiden (nur wieder herzustellen durch den Administrator, gesichert durch ein Passwort)
Reiter "MAT-Anfo (AB)":
Verdeckt, nur über Klick auf Button aufrufbar. Hier gibt der Ingenieur oder Designer seine MAT-Anforderung ein
Reiter "MasterList-Neu":
Sichtbar für alle (Reiter bleibt auch sichtbar). Hier kann der Ingenieur seine Bestellungen noch einmal überprüfen, diese wieder löschen und/oder durchstreichen (über Makro). Das gesamte Sheet soll gesperrt werden, bis auf die letzten drei Reihen. In denen gibt der Logistik-Mann seine MAT-Infos (ist das MAT als "Gefährliche Güter" zu klassifizieren, wann ist es zu erwarten und wurde es überprüft.
Die folgenden 6 Reiter:
Hier wird die MAT-Order dem Flugzeugbereich zugeordnet, z.B. Floor oder Sitze. Diese Reiter sollen auch verdeckt und nur durch Makro aufrufbar sein.
Es ist gut möglich, dass hier noch einige Reiter (Tabellen) zugefügt werden.
Die letzten zwei Reiter "MAT-LLI" und "Fragen":
werden nach Fertigstellung gelöscht - sind nur für die Diskussion.
Ich möchte das Tool demnächst vorstellen und erklären, im Beisein von einigen Ingenieuren und auch einem Logistik-Team. Ich rechne damit, dass es dann noch Wünsche oder Vorschläge gibt, welche mich noch einmal "fordern werden" :-) ...
Deine Frage nach dem Speichern der Datensätze ist berechtigt gut. Aber nein, das ist nicht nötig, da die einzelnen Tabellen bei Fertigstellung des Flugzeuges ausgedruckt und den offiziellen Papieren zugeordnet werden (als PDF).
Ich hoffe, lieber Werner, ich konnte Dir das Ganze nun etwas erklären und noch einmal: Ich muss mich schon jetzt unheimlich bei Dir bedanken !!! In unserem Team gibt es keine VBA-Erfahrungen. Nur ich hab damit schon in vergangener Zeit Einiges für die Firma "gebastelt" ... aber halt auf kleinem Niveau, darum bin ich der einzige "VBA-Azubi" :-) Und ohne Deine Hilfe hätte ich keine Chance, das Tool rechtzeitig fertig zu stellen.
DANKE !!!!
Gestern bastelte ich noch etwas am Design und setzte noch ein paar Makros ein. Als Anhang die neueste Version.
Wenn Du Zeit und Lust hast, schaue es Dir an - und vielleicht kannst Du mir noch etwas helfen beim Einbeziehen aller Tabellen nach Löschen/Durchstreichen von Daten in der MasterList.
P/S: Bei der Präsentation werde ich Dich erwähnen, sofern Du Nichts dagegen hast :-)
https://www.herber.de/bbs/user/125281.xlsm

Beliebteste Forumthreads (12 Monate)

Zelle finden, Zeile kopieren in neue Tabelle

30
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

308 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zelle finden, Zeile kopieren in neue Tabelle

30 Beiträge zum Forumthread Beiträge zu diesem Forumthread

308 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

30
Beiträge zum Forumthread

Beiträge zu diesem Forumthread