44 Aufrufe
Gefragt in Tabellenkalkulation von michigf Einsteiger_in (14 Punkte)

Hallo,

da ich VBA Newbie bin und es auch schon mit Wenn und Sverweis probiert habe, was auch zum teil funktionierte.

Leider wurde der Eintrag bei Änderung der bestimmten Zelle dann immer wieder zurückgesetzt.

Also folgendes Szenario :

Arbeitmappe1 mit beschrifteten Tabellenblätter vom Inhalt identisch (können von der Anzahl her schwanken)

Arbeitmappe2 beinhaltet die Namen der Tabellen aus Arbeitsmappe1. Hinter diesen Namen steht ein Betrag der bei Änderung einer Zelle in Arbeitsmappe2, dann Namentlich und Monatlich in der Spalte Ergebnis des jeweiligen Tabellenblatt der Arbeitsmappe1 kopiert werden soll.

Ich hänge mal eine Beispieldatei mit an falls man mich nicht verstehtfrown

Ich hoffe das mir trotzdem jemand helfen kann und sage schon mal Danke

Horst

https://supportnet.de/forum/?qa=blob&qa_blobid=3156548740176941537

4 Antworten

0 Punkte
Beantwortet von m-o Profi (18.9k Punkte)
ausgewählt von michigf
 
Beste Antwort

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.

0 Punkte
Beantwortet von michigf Einsteiger_in (14 Punkte)

Hallo M.O.

erst einmal vielen, vielen Dank das Du Dir soviel Mühe gemacht hast. Ich hätte das nicht so hin bekommen.

"Monat mittels Datenüberprüfung auswählen" ist das auch schon intregriert? Und wenn was muss ich einfügen.

Eine Frage hab ich noch. Geht es auch zu Starten nach direkter Eingabe des Monats Abschluss mit Enter

oder nur wenn ich folge Monat eingebe.

Also nochmals vielen Dank. Es funktioniert wie ich es mir erhofft habe. Super!!!

Horst

0 Punkte
Beantwortet von m-o Profi (18.9k Punkte)
Hallo Horst,

in der bearbeiteten Tabelle, die ich in meiner Antwort verlinkt habe, ist die Datenüberprüfung schon integriert. Das siehst du daran, dass du den Monat mit einem Drop-Down-Menü auswählen kannst. Die Monate stehen ja direkt unter deiner Tabelle. In deiner echten Tabelle kannst du die betreffenden Zeilen ausblenden oder die Liste in ein anderes Tabellenblatt schreiben. Ich habe dir in meiner ersten Antwort auch einen Link zum Thema "Datenüberprüfung" hinterlegt (einfach auf das blau geschriebene Wort "Datenüberprüfung" klicken).

Das Makro startet, sobald sich der Inhalt der Zelle H2 ändert. Dabei ist es egal, ob du den Monat eingibst (und danach die Zelle verlässt) oder per Drop-Down-Menü auswählst und welchen Monat du auswählst. Wichtig ist nur, dass der neue Inhalt sich vom alten Inhalt unterscheiden muss.

Gruß

M.O.
0 Punkte
Beantwortet von michigf Einsteiger_in (14 Punkte)

Hallo M.O.

ja ich weiss, wer Lesen kann ist klar im Vorteilwink

Habe jetzt alles verstanden und probiert, es läuft hervorragend.

Nochmals vielen Dank und lieben Gruß

Horst

...