Hallo Horst,
füge das folgende Makro in das VBA-Projekt der Tabelle ein, aus der die Daten kopiert werden sollen:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strMonat As String
Dim strDatei As String
Dim wbZiel As Workbook
Dim arrDaten() As Variant
Dim lngLetzte As Long
Dim lngZeile As Long
Dim lngZaehler As Long
Dim d As Long
Dim w As Long
Dim rngSuche As Range
'Name und Pfad zur anderen Arbeitsmappe - anpassen
strDatei = "C:\Users\Horst\Documents\Arbeitsmappe1.xlsm"
If Not Intersect(Target, Range("H2")) Is Nothing Then
'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False
'Meldungen ausschalten
Application.EnableEvents = False
'letzte Eingabe rückgängig machen
Application.Undo
'alten Inhalt der Variable für Monat zuweisen
strMonat = Target.Value
'Rückgängigmaachen des Rückgängigmachens
Application.Undo
'Meldungen wieder einschalten
Application.EnableEvents = True
'zu übertragende Daten einlesen
'prüfen, ob Werte verschieden
If strMonat <> Target.Value Then
'falls ja, dann...
'letzte Zeile im aktuellen Blatt in Spalte A ermitteln
lngLetzte = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Feld für zu übertragende Daten redimensionieren - Feld beginnt bei Null
ReDim arrDaten(lngLetzte - 6, 1)
'Daten in das Feld einlesen - ab Zeile 6
For lngZeile = 6 To lngLetzte
arrDaten(lngZaehler, 0) = Cells(lngZeile, 1) 'Name aus Spalte A
arrDaten(lngZaehler, 1) = Cells(lngZeile, 20) 'Betrag aus Spalte T
lngZaehler = lngZaehler + 1
Next lngZeile
'Arbeitsmappe öffnen
Set wbZiel = Workbooks.Open(strDatei)
'eingelesene Daten durchlaufen, um die Daten in die Tabellenblätter der Zieldatei eintragen zu können
For d = LBound(arrDaten, 1) To UBound(arrDaten, 1)
For w = 1 To wbZiel.Worksheets.Count
'Namen mit Namen der Arbeitsblätter in Zielmappe vergleichen
If arrDaten(d, 0) = wbZiel.Worksheets(w).Name Then
'Monat suchen
Set rngSuche = wbZiel.Worksheets(w).Range("B:B").Find(strMonat, LookIn:=xlValues)
'Spalte C füllen, wenn Suche erfolgreich war
If Not rngSuche Is Nothing Then
wbZiel.Worksheets(w).Cells(rngSuche.Row, 3) = arrDaten(d, 1)
'und rngSuche zurücksetzen
Set rngSuche = Nothing
End If
End If
Next w
Next d
'Zielarbeitsmappe wieder schließen
wbZiel.Close (True)
End If
'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True
'Abschlussmeldung
MsgBox "Die Daten wurden übertragen.", 48, "Hinweis"
End If
End Sub
Den Namen sowie den Pfad der Zieltabelle musst du natürlich auf deine Verhältnisse anpassen.
Das Kopieren der Daten startet automatisch, sobald du einen anderen Monat in Zelle H2 eingibst. Um Schreibfehler bei der Eingabe des Monats zu vermeiden, würde ich den Monat mittels Datenüberprüfung auswählen. Die Daten werden in Spalte C der Arbeitsmappe1 eingefügt. Eventuell vorhandene Daten werden überschrieben. Wird der Monat nicht gefunden, werden natürlich keine Daten eingefügt und es erfolgt auch kein entsprechender Hinweis.
Schau mal, ob alles so funktioniert wie du willst.
Hier die bearbeitete Datei: Download
Gruß
M.O.
