Werte per Mausklick von "Tabelle_1" in leere Zeile von "Tabelle_2"

[August]

Hallo Schauan und Gast 123!

@ Schauan

Danke fürs Helfen! Dein Code-Schnipsel funktioniert sehr gut. Wenn ich den Code ausführe, bleibt aber ein "Problem" bestehen: Der Code kopiert den Inhalt der angewählte Zelle (Spalte "E"), die in meinem Fall (bis auf die Bilder) leer sind. Somit wird schliesslich nichts in die Matrix kopiert. Ist es möglich einen Verweis auf Spalte "B" zu codieren (-> also den offset-Wert von Zelle "E xyz" auf "B xyz")? In dieser Komplexitätsstufe von Code ist es mir nicht vergönnt, dies selber anzupassen. 

Du hast noch gemeint, dass es ein Problem mit dem Tabellenaufbau geben würde. Das stimmt. Das habe ich jetzt beim Ausprobieren ebenfalls gemerkt. Dein Input, Produktklassen anzufügen, zu sortieren usw. wäre bestimmt eine Lösung. Ich nehme an, dass es nicht möglich ist, den Zellen einer Produktklasse vordefinierte Zellen in der Matrix zuzuweisen, von wo aus sie die nächst freie Zelle besetzen sollen? Also, dass alle Zellen der Produktklasse 1 der Tabelle "Produkte" in die nächst freie Matrixzellen von Zeile ? bis ?? kopiert werden, alle Zellen der Produktklasse 2 in die nächst freie Matrixzellen Zeile ?? bis ???? usw.? Falls nein, glaube ich, dass der von Atilla vorbereitete Code - obschon genial - ggf. weniger geeignet ist und stattdessen vielleicht besser über mehrere VBA-Module gearbeitete würde?

Mein Ziel ist immer noch, dass der Wert von Zellen "B" durch Auswählen (Anklicken, Doppelklicken oder was auch immer) der korrespondierenden Zellen "E" in eine neue Tabelle kopiert werden und dort in die nächst freie Zelle "B" einer Matrix gesetzt werden. Der Startpunkt für die nächst freie Zelle in dieser Matrix sollte jedoch manuell gewählt werden können (um die Zuordnung bzw. einer Kategorie innerhalb der Matrix zu ermöglichen).   


@ Gast 123

Danke auch dir fürs Helfen! Dein Code funktioniert sehr gut. Was meine vereinfachte Beispielsdatei nicht ganz offensichtlich wiedergab, ist, dass die Zeilennummern beider Tabellen nicht korrelieren. Die Zeilennummer der Produkt-Zellen in Tabelle "Produkte" entspricht also nicht mit der Zeilennummer in Tabelle "Auswertung" überein. In Realität ist die Matrix in der Tabelle "Auswertung" viel kleiner als die Liste aller Produkte in Tabelle "Produkte". In diese Matrix sollen nur ausgewählte Produkte kopiert werden und dort innerhalb einer Produktklasse in die nächst freie Zelle innerhalb Spalte "B" gesetzt werden. 
   

Ich weiss nicht, inwiefern man das mit deinem Code anpassen könnte? Ich möchte auch nicht zu viel Umstände machen, dein Code scheint ja bereits sehr komplex und war bestimmt Zeit intensiv in der Herstellung.

[Gast 123]

Hallo

keine Sorge, dieser Code ist im normalen Rahmen.  Hier eine neue Version zum auswechseln im Modul1.
Was noch angegeben werden muss ist in Const ALZ = 16 die letzte Zeile in deiner -Original Tabelle-!!   (können > 100 sein)
Der neue Code sucht zuerst die Kategorie, danach die naechste Freie Zelle, mit Überlauf Meldung wenn eine Kategorie voll ist !!

mfg  Gast 123

Code:

Option Explicit      '14.4.2017   Gast 123   Clever Forum
'erweitert um For Next

Const PRD = "Produkte"
Const ASW = "Auswertung"
Const ALZ = 16  'Letzte Zelle in Auswertung


Sub Bild_BeiKlick()
Dim Adr, Schfla, PName, Zeile
Dim Kateg, Txt, a, j 'neu Kategorie

  Schfla = Application.Caller
  Adr = ActiveSheet.Shapes(Schfla).BottomRightCell.Address
     
With Worksheets(PRD)
  Zeile = .Range(Adr).Row
  PName = .Cells(Zeile, "B").Value
  Kateg = .Cells(Zeile, "A").End(xlUp).Value

  '1.Schleife suche Kategorie 1-3
  For a = 2 To ALZ
     If Worksheets(ASW).Cells(a, "B") = Kateg Then
    '2.Schleife suche naechste leere Zelle
     For j = a + 1 To ALZ
        'Produkt in naechste leere Zelle und Ende
        If Worksheets(ASW).Cells(j, "B") = Empty Then
           Worksheets(ASW).Cells(j, "B") = PName
           Exit Sub
        End If
        'Fehlermeldung wenn Produktspeicher voll ist
        Txt = Worksheets(ASW).Cells(j, "B").Value
        If j = ALZ Or InStr(Txt, Left(Kateg, Len(Kateg) - 2)) Then
           MsgBox Kateg & "  ist voll !!":  Exit Sub
        End If
     Next j
     End If
  Next a
End With
End Sub

[August]

Hallo Gast 123,

dein Code funktioniert ausgezeichnet! An dieser Stelle noch einmal vielen Dank für deine Zeit und Hilfestellung! Somit ist mein Problem gelöst.  :18:

Beste Grüsse: August

[Gast 123]

Hallo August

ich danke mich für die nette Rückmeldung, freut mich sehr das es klappt.

mfg  Ast 123