jensson
Goto Top

Excel 2010 Makro: Intelligentes Kopieren von Daten in 2 Tabellenblättern

Hallo face-smile
Ich bin Einsteiger in VBA, beziehungsweise möchte lernen, Makros zu schreiben und habe dafür eine Testaufgabe bekommen. Ich habe 2 Tabellenblatter. In diesen ist jeweils eine Tabelle mit teilweise unterschiedlichen Inhalten. Das Makro soll in der Kopfzeile von Tabelle2 gucken, ob es die Überschriften der Spalten auch uin Tabelle1 gibt und wenn ja, die Werte aus Tabelle1 die unter dieser Überschrift stehen in die entsprechende Spalte in Tabelle2 kopieren. Dabei soll es aber auch schauen ob die Zeile an dieser Stelle überhaupt frei ist, und wenn nicht, eine Zeile weiter runtergehen (oder eben so weit wie nötig). Bilder der Tabellen sind angehängt.
Es wäre super wenn man das Skript noch erklären könnte, bzw. Kommentare unter die Befehle schreiben könnte, damit ich das verstehen und lernen kann.
Vielen Dank im Vorraus face-smile

38d0516e968b8620033472c9f24ac0b2


c319416525423b00d0756e4f8c6b0423

Content-Key: 246283

Url: https://administrator.de/contentid/246283

Ausgedruckt am: 29.03.2024 um 13:03 Uhr

Mitglied: keine-ahnung
keine-ahnung 12.08.2014 um 12:51:24 Uhr
Goto Top
Moin,
Inteligentes Kopieren
ooops face-wink!
Bilder der Tabellen sind angehängt.
Doppeloops face-smile

LG, Thomas
Mitglied: colinardo
Lösung colinardo 12.08.2014 aktualisiert um 14:32:43 Uhr
Goto Top
Hallo Jenson, Willkommen auf Administrator.de!
Deine Bilder hast du leider nicht richtig hochgeladen, hier aber trotzdem ein Beispiel-Sheet nach deiner Beschreibung: CompareAndCopy_246283.xlsm. Kommentare befinden sich im Code.

Sub SearchAndCopy()
    Dim ws1 As Worksheet, ws2 As Worksheet, f As Range, cell As Range, rngWert As Range, currentTarget As Range, rngContent As Range
    'Tabellenblätter referenzieren  
    Set ws1 = Worksheets(1)
    Set ws2 = Worksheets(2)
    ' Für jede Überschrift in Tabelle2  
    For Each cell In ws2.Range("A1", ws2.Cells(1, Columns.Count).End(xlToLeft))  
        ' Für jede Überschrift im Bereich der Überschriften in Tabelle1  
        With ws1.Range("A1", ws1.Cells(1, Columns.Count).End(xlToLeft))  
            'Suche die aktuelle Überschrift in Tabelle2 im Bereich von Tabelle1  
            Set f = .Find(cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
            'Nur wenn die Überschrift gefunden wurde ...  
            If Not f Is Nothing Then
                ' belegten Bereich unter der jeweiligen Überschrift ermitteln  
                Set rngContent = ws1.Range(f.Offset(1, 0), ws1.Cells(Rows.Count, f.Column).End(xlUp))
                ' für jede Zelle im belegten Bereich ...  
                For Each rngWert In rngContent
                    ' Bereich in Tabelle2 eine Zeile nach unten verschieben  
                    Set currentTarget = cell.Offset(1, 0)
                    ' Bereich solange nach unten verschieben bis eine nicht leere Zelle kommt  
                    While currentTarget.Value <> ""  
                        Set currentTarget = currentTarget.Offset(1, 0)
                    Wend
                    'Schreibe den Inhalt in die Zielzelle  
                    currentTarget.Value = rngWert.Value
                Next
            End If
        End With
    Next
End Sub

Grüße Uwe

back-to-topSo fügt man Bilder zum Beitrag hinzu:
1. Im Ursprungsbeitrag(Frage) auf Bearbeiten klicken
2. Auf den Tab Bilder wechseln und mit Bild hinzufügen ein Bild hinzufügen
dd734be15ff48f33bc796357a8bdbedd
3. Den angezeigten Bildcode kopieren und in deine Kommentar/Beitrag einfügen
32bd385f49561db36766b75506800d13
Mitglied: Jensson
Jensson 12.08.2014 um 14:07:35 Uhr
Goto Top
Hi Uwe,

die Bilder sind jetzt richtig hochgeladen.Ich habe das Makro mal in dem Excel Dokument eingefügt und mit dem Skript ausprobiert, jedoch passiert nichts. Ich wüsste jetzt aber auch nicht was ich da anpassen müsste :I Hättest du nochmal die Güte einem kleinen Anfänger wie mir zu helfen?
Vielen Dank face-smile
Mitglied: colinardo
Lösung colinardo 12.08.2014 aktualisiert um 14:48:51 Uhr
Goto Top
Zitat von @Jensson:
die Bilder sind jetzt richtig hochgeladen.Ich habe das Makro mal in dem Excel Dokument eingefügt und mit dem Skript
ausprobiert, jedoch passiert nichts.
Mein Beispiel-Sheet läuft, läuft es bei dir? wenn nicht, ist bei Dir dir Ausführung von Makros im Sicherheitscenter von Excel überhaupt aktiviert ?
Mitglied: Jensson
Jensson 12.08.2014 um 14:28:44 Uhr
Goto Top
Ah, Okay.
Das Problem hat sich soeben erledigt face-smile
Vielen Vielen Dank!
Mitglied: Ronniedinho2
Ronniedinho2 23.10.2015 um 13:27:14 Uhr
Goto Top
Hallo,

gibt es hierbei auch die Möglichkeit benutzerdefinierte Abfragen zu starten? Habe das kopieren und einfügen per Makro hinbekommen. Müsste aber in meiner Tabelle nach Kriterien suchen lassen. Hat jemand einen Tipp für mich?

Besten Dank
Mitglied: 122990
122990 23.10.2015 um 14:01:21 Uhr
Goto Top
Zitat von @Ronniedinho2:
gibt es hierbei auch die Möglichkeit benutzerdefinierte Abfragen zu starten? Habe das kopieren und einfügen per Makro hinbekommen. Müsste aber in meiner Tabelle nach Kriterien suchen lassen. Hat jemand einen Tipp für mich?

Neue Frage neuer Thread ...!
Danke.

Gruß grexit