Daten aus Liste in Formular ziehen
19.07.2023 08:12:07
Sven
ich suche nach einer Lösung, um Daten aus einer Liste in ein Formular zu ziehen.
Die Liste besteht aus 250 Zeilen und 174 Spalten
Was ich möchte:
Wenn ich im Arbeitsblatt A in Feld A4 eine Zahl eingebe, die einer fortlaufenden Nummer in Spalte B des Arbeitsblattes D entspricht, dann sollen die Werte aus der entsprechenden Zeile in verschiedene Felder meiner Eingabemaske übernommen werden.
Folgendes soll gemacht werden:
Blatt A Nummer eingeben
Blatt D Zeile wird angesprochen, in der sich in Spalte B diese Nummer befindet und die Daten aus D in A einfügen:
Blatt D Wert aus Spalte C in A Feld C5 einfügen
Blatt D Wert aus Spalte E in A Feld C6
Blatt D Wert aus Spalte F:I in A Feld C7:C10
Blatt D Wert aus Spalte Y:AH in A Feld C13:L13
Blatt D Wert aus Spalte AI:AR in A Feld C14:L14
Den umgekehrten Fall habe ich bereits in der Tabelle vorhanden:
In A werden die Daten manuell erfasst. Über einen Button wird dann ein Makro ausgeführt, dass die Daten in D einfügen. Ich kriege es aber irgendwie nicht hin, das Ganze umgekehrt zu machen. Hier der Code dafür:
Sub transfer_werte()
Dim shtEingabemaske As Excel.Worksheet
Dim rngStandort As Excel.Range
Dim rngKopfdaten As Excel.Range
Dim rngAdresse As Excel.Range
Dim rngLiefer As Excel.Range
Dim rngGewicht As Excel.Range
Dim rngColli1 As Excel.Range
Dim rngColli2 As Excel.Range
Dim rngColli3 As Excel.Range
Dim rngColli4 As Excel.Range
Dim rngColli5 As Excel.Range
Dim rngColli6 As Excel.Range
Dim rngColli7 As Excel.Range
Dim rngColli8 As Excel.Range
Dim rngColli9 As Excel.Range
Dim rngColli10 As Excel.Range
Dim rngColli11 As Excel.Range
Dim rngColli12 As Excel.Range
Dim rngColli13 As Excel.Range
Dim rngColli14 As Excel.Range
Dim rngColli15 As Excel.Range
Dim rngEmail As Excel.Range
Dim rngMRN As Excel.Range
Dim rngIncoterm As Excel.Range
Set shtEingabemaske = ThisWorkbook.Worksheets("Eingabemaske")
Set rngStandort = shtEingabemaske.Range("U28:U29")
Set rngMRN = shtEingabemaske.Range("C6")
Set rngKopfdaten = shtEingabemaske.Range("C7:C10")
Set rngAdresse = shtEingabemaske.Range("E5:E10")
Set rngLiefer = shtEingabemaske.Range("I5:I10")
Set rngGewicht = shtEingabemaske.Range("Q5:Q7")
Set rngColli1 = shtEingabemaske.Range("C13:L13")
Set rngColli2 = shtEingabemaske.Range("C14:L14")
Set rngColli3 = shtEingabemaske.Range("C15:L15")
Set rngColli4 = shtEingabemaske.Range("C16:L16")
Set rngColli5 = shtEingabemaske.Range("C17:L17")
Set rngColli6 = shtEingabemaske.Range("C18:L18")
Set rngColli7 = shtEingabemaske.Range("C19:L19")
Set rngColli8 = shtEingabemaske.Range("C20:L20")
Set rngColli9 = shtEingabemaske.Range("C21:L21")
Set rngColli10 = shtEingabemaske.Range("C22:L22")
Set rngColli11 = shtEingabemaske.Range("C23:L23")
Set rngColli12 = shtEingabemaske.Range("C24:L24")
Set rngColli13 = shtEingabemaske.Range("C25:L25")
Set rngColli14 = shtEingabemaske.Range("C26:L26")
Set rngColli15 = shtEingabemaske.Range("C27:L27")
Set rngEmail = shtEingabemaske.Range("Q8")
With Worksheets("Daten")
With .Cells(.Rows.Count, "C").End(xlUp)
.Offset(1, 0).Resize(rngStandort.Columns.Count, rngStandort.Rows.Count).Value = Application.Transpose(rngStandort.Value)
.Offset(1, 2).Resize(rngMRN.Rows.Count, rngMRN.Columns.Count).Value = rngMRN.Value
.Offset(1, 3).Resize(rngKopfdaten.Columns.Count, rngKopfdaten.Rows.Count).Value = Application.Transpose(rngKopfdaten.Value)
.Offset(1, 7).Resize(rngAdresse.Columns.Count, rngAdresse.Rows.Count).Value = Application.Transpose(rngAdresse.Value)
.Offset(1, 13).Resize(rngLiefer.Columns.Count, rngLiefer.Rows.Count).Value = Application.Transpose(rngLiefer.Value)
.Offset(1, 19).Resize(rngGewicht.Columns.Count, rngGewicht.Rows.Count).Value = Application.Transpose(rngGewicht.Value)
.Offset(1, 22).Resize(rngColli1.Rows.Count, rngColli1.Columns.Count).Value = rngColli1.Value
.Offset(1, 32).Resize(rngColli2.Rows.Count, rngColli2.Columns.Count).Value = rngColli2.Value
.Offset(1, 42).Resize(rngColli3.Rows.Count, rngColli3.Columns.Count).Value = rngColli3.Value
.Offset(1, 52).Resize(rngColli4.Rows.Count, rngColli4.Columns.Count).Value = rngColli4.Value
.Offset(1, 62).Resize(rngColli5.Rows.Count, rngColli5.Columns.Count).Value = rngColli5.Value
.Offset(1, 72).Resize(rngColli6.Rows.Count, rngColli6.Columns.Count).Value = rngColli6.Value
.Offset(1, 82).Resize(rngColli7.Rows.Count, rngColli7.Columns.Count).Value = rngColli7.Value
.Offset(1, 92).Resize(rngColli8.Rows.Count, rngColli8.Columns.Count).Value = rngColli8.Value
.Offset(1, 102).Resize(rngColli9.Rows.Count, rngColli9.Columns.Count).Value = rngColli9.Value
.Offset(1, 112).Resize(rngColli10.Rows.Count, rngColli10.Columns.Count).Value = rngColli10.Value
.Offset(1, 122).Resize(rngColli11.Rows.Count, rngColli11.Columns.Count).Value = rngColli11.Value
.Offset(1, 132).Resize(rngColli12.Rows.Count, rngColli12.Columns.Count).Value = rngColli12.Value
.Offset(1, 142).Resize(rngColli13.Rows.Count, rngColli13.Columns.Count).Value = rngColli13.Value
.Offset(1, 152).Resize(rngColli14.Rows.Count, rngColli14.Columns.Count).Value = rngColli14.Value
.Offset(1, 162).Resize(rngColli14.Rows.Count, rngColli15.Columns.Count).Value = rngColli15.Value
.Offset(1, 172).Resize(rngEmail.Columns.Count, rngEmail.Rows.Count).Value = Application.Transpose(rngEmail.Value)
End With
End SubP.S.: Eine Beispieldatei kann ich aktuell noch nicht anbieten, da die Datei sehr groß ist und die Uploadgröße übersteigt und sich darin Daten befinden. Ich bastel gerade eine abgespeckte Version zum Upload zusammen. Da ich die Datei nicht erstellt habe, bin ich noch nicht ganz dahintergestiegen, was wo wie zusammenspielt. Muss mich da noch durchwursten.
Aber ich frage schon mal, vielleicht ist es ja so einfach, dass direkt jemand weiß was ich will und es umsetzen kann. Schon mal vielen lieben Dank für eure Unterstützung.