Per Knopfdruck Mengen übertragen

Hallo zusammen,
ich habe folgendes Problem:
Ich habe eine Exceltabelle mit 2 Tabellenblätter.
In Tabelle1 (Monatsmengen) stehen von C1-DI1 Monatsmengen in den Spalten und zwar in jeder 2ten Zelle d.h. in C1 E1 G1 I1 K1 etc.
In B1 D1 F1 H1 J1 stehen die IDs.
In A8 steht für den jeweiligen Monat immer : "Menge Obtober" oder "Menge November" etc.
In Tabelle2 (Quelle) stehen in Spalte G die selben IDs.
In Spalte P sollen die Monatsmengen für den Oktober rein
In Spalte Q sollen die Monatsmengen für den November rein
In Spalte R sollen die Monatsmengen für den Dezember rein
usw.
Allerdings soll er die ID miteinander vergleichen und wenn diese mit den beiden Tabellenblätter übereinstimmt dann soll er z.b. gucken:
Wenn B1(Monatsmengen)=SpalteG(Quelle)dann gib den Wert aus C1 in die entsprechende Zelle zurück.
Und wenn in den Monatsmenge bei A8 Menge Obtober steht dann in Spalte P(Quelle) rein.
Und das ganze soll halt per VBA gelöst werden allerdings komme ich nicht weiter und hoffe auf eure Hilfe.
Ich habe für euch mal eine Beispieldatei hochgeladen.
Dort steht es schon so drin wie es eigentlich soll - bloß per Knopfdruck für den jeweiligen Monat. Die Datei ist sehr gekürzt und dient als Beispiel, d.h. in Echt sind noch viel mehr Werte vorhanden:
https://www.herber.de/bbs/user/87666.xls
Für eure Hilfe wäre ich sehr dankbar.
LG
Detlef

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub Uebertrage() Dim mDic As Object, mm As Long, nn As Long, arQ Dim cc As Long, strMon As String, lngMon As Long Set mDic = CreateObject("Scripting.Dictionary") ' Zählpkt/Menge With Sheets("Monatsmengen") ' Quell-Tabellenblatt nn = .Cells(1, .Columns.Count).End(xlToLeft).Column - 1 ' Spaltenzahl arQ = .Cells(1, 2).Resize(, nn) ' Quelldaten strMon = .Cells(8, 1) ' Monatsbez. End With With Sheets("Quelle") ' Ziel-Tabellenblatt mm = .Cells(.Rows.Count, 7).End(xlUp).Row - 1 ' Zeilenzahl For cc = 1 To mm mDic.Add .Cells(cc + 1, 7).Value, "" ' Zählpkte einlesen Next cc mm = .Cells(1, .Columns.Count).End(xlToLeft).Column ' Spaltenzahl For cc = mm To 1 Step -1 If .Cells(1, cc) = strMon Then lngMon = cc ' Spalte d. Monats Exit For End If Next cc If cc

Beliebteste Forumthreads (12 Monate)

Per Knopfdruck Mengen übertragen

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Per Knopfdruck Mengen übertragen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread