Kopieren vba

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi
Mir geht es gleich wie Daniel (Spalte, Zeile, verwirrend). Lustigerweise hat ChatGPT (Link im Forumstitel) deine Beschreibung verstanden :)
(der AI-generierte Muster-Code mit zwei Schleifen ist nicht ideal/performant, aber wenn die Datenmengen eher klein ist, kein Problem)
excel vba
Ich möchte im Tabellenblatt 1 Spalte A2 mit Spalte D1 aus Tabellenblatt 2 vergleichen, wenn diese gleich sind soll er die Werte von der Tabellenblatt 1 (Bereich J2 bis U2) nach Tabellenblatt 2 kopieren (unter der Vergleichsspalte Spalte D1 aus Tabellenblatt 2.)
Anschließend soll er die nächste Spalte vergleichen bis zum letzten Eintrag.
Untenstehend finden Sie ein Beispiel-VBA-Code, der Ihre Anforderungen erfüllt:

Sub VergleichenUndKopieren()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrow1 As Long, lastrow2 As Long
Dim i As Long, j As Long
Set ws1 = ThisWorkbook.Sheets("Tabellenblatt1")
Set ws2 = ThisWorkbook.Sheets("Tabellenblatt2")
lastrow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
lastrow2 = ws2.Cells(ws2.Rows.Count, "D").End(xlUp).Row
For i = 2 To lastrow1
For j = 2 To lastrow2
If ws1.Cells(i, 1).Value = ws2.Cells(j, 4).Value Then
ws1.Range("J" & i & ":U" & i).Copy
ws2.Cells(j, 4).End(xlToRight).Offset(1, 0).PasteSpecial xlPasteValues
Exit For
End If
Next j
Next i
End Sub

Verwenden Sie diesen Code, indem Sie ein Modul in Ihrem Projekt erstellen und ihn einfügen. Vergessen Sie nicht, das Projekt zu speichern und dann auszuführen.
cu
Chris

Sub VergleichenUndKopieren() Dim ws1 As Worksheet, ws2 As Worksheet Dim lastrow1 As Long, lastrow2 As Long Dim i As Long, j As Long Set ws1 = ThisWorkbook.Sheets("Tabellenblatt1") Set ws2 = ThisWorkbook.Sheets("Tabellenblatt2") lastrow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row lastrow2 = ws2.Cells(ws2.Rows.Count, "D").End(xlUp).Row For i = 2 To lastrow1 For j = 2 To lastrow2 If ws1.Cells(i, 1).Value = ws2.Cells(j, 4).Value Then ws1.Range("J" & i & ":U" & i).Copy ws2.Cells(j, 4).End(xlToRight).Offset(1, 0).PasteSpecial xlPasteValues Exit For End If Next j Next i End Sub

Hi Tim
Ich würde es ohne VBA lösen. In Tabellenblatt1!H1 einen Titel einfügen z.B. "Einheit"
Pivot-Tabellenbericht
Quelle markieren und Pivot einfügen.
Menü PivotTable-Analyse, Felder Elemente und Gruppen, berechnetes Feld
SummeJahr = Jan +Feb +Mrz +Apr +Mai +Jun +Jul +Aug +Sep +Okt +Nov +Dez
Spalten = Einheit, Zeilen = Jahr, Werte = SummeJahr
Als Formel
Aus den Quelldaten eine "intelligente Tabelle" machen d.h. Menü Start, Als Tabelle formatieren
Formel für Tabellenblatt2!D2:

{=SUMME(Tabelle1[[Jan]:[Dez]]*(INDIREKT("Tabelle1[Einheit]")=D$1)*(INDIREKT("Tabelle1[Jahr]")=$C2)) }

Geschweifte Klammer mit Ctrl+Shift+Enter erzeugen.
Als Power-Query
- Quelldaten markieren
- Menü Daten, Aus Tabelle/Bereich
- Spalten Einheit + Jahr markieren, rechte Maustaste, entpivotieren
- Spalten Einheit + Jahr markieren, Menü Start, Gruppieren nach (Summe auf Wert)
- Spalten Einheit markieren, Menü Transformieren, Spalte pivotieren
Insgesamt also viele Möglichkeiten, um die Aufgabe ohne VBA zu lösen. Scheint mir sinnvoll auf VBA zu verzichten, wenn die entsprechenden Kenntnisse fehlen.
Aus meiner Sicht handelt es sich um eine klassische Pivot-Aufgabe. Einzig das Eliminieren der Monate stellt eine kleine Hürde dar, was aber wie aufgezeigt über ein berechnetes Feld gelöst werden kann.
cu
Chris

Sub SammelnUndAusgeben() Dim Z As Range Dim r As Long, c As Long Dim ws1 As Worksheet Dim Abt Dim Jahr Dim Abt_dic As Object Dim Jahr_dic As Object Dim Wert_dic As Object 'Init Set Abt_dic = CreateObject("Scripting.Dictionary") Set Jahr_dic = CreateObject("Scripting.Dictionary") Set Wert_dic = CreateObject("Scripting.Dictionary") 'Sammeln With ThisWorkbook.Sheets("Tabellenblatt1") For Each Z In Range(.Range("H2"), .Cells(.Rows.Count, "H").End(xlUp)) Abt = CStr(Z.Value) Jahr = CStr(Z.Offset(0, 1).Value) Abt_dic(Abt) = Abt_dic(Abt) + 1 'sammeln und aufzählen Jahr_dic(Jahr) = Jahr_dic(Jahr) + 1 'sammeln und aufzählen For i = 3 To 14 Wert_dic(Abt & ";" & Jahr) = CLng(Wert_dic(Abt & ";" & Jahr)) + Z.Offset(0, i).Value Next Next End With 'Herausgeben With ThisWorkbook.Sheets("Tabellenblatt2") .Cells.ClearContents c = 4 For Each Abt In Abt_dic.keys .Cells(1, c).Value = Abt r = 2 For Each Jahr In Jahr_dic.keys .Cells(r, 3).Value = Jahr .Cells(r, c).Value = Wert_dic(Abt & ";" & Jahr) r = r + 1 Next c = c + 1 Next End With Set Abt_dic = Nothing Set Jahr_dic = Nothing Set Wert_dic = Nothing End Sub

Worksheets("Pivot-Tabelle").PivotTables("PivotTable1").PivotCache.Refresh With Worksheets("Tabellenblatt2").Range("D2:F4") .Formula = "=GETPIVOTDATA(""SummeJahr"",'Pivot-Tabelle'!$A$3,""Einheit"",D$1,""Jahr"",$C2)" .Value = .Value End With

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Kopieren vba

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread