Tabelle kopieren und Inhalte anpassen

Moin,
Da ich in VBA nicht so bewandert bin, brauche ich HIlfe zu Folgendem:
Ich habe zwei Tabellen in einem Worksheet. Eine voll, eine leer. Excel soll die Inhalte der zweiten Tabelle in an die jeweils richtige Stelle in der ersten Tabelle setzen:
Tabelle2: (Oberbegriff: Beispiel)
Obst: Pfirsich
Gemüse: Salat
Technik: TV
Tabelle1 ist noch leer, hier stehen nur die Oberbegriffe.Ergebnis soll sein:
Tabelle1:
Technik: TV
Obst: Pfirsich
Gemüse: Salat
Die Oberbegriffe von Tabelle1 stehen in B2:B8, die Beispiele sollen eingefügt werden in Range D2:K8.
Tabelle2:
Oberbegriffe stehen in Range L17:L24, die Beispiele in Range N17:R24
Also zusammengefasst: Kopiere die Inhalte der zweiten Tabelle in die ersten und platziere sie nach dem Kopiervorgang an die jeweils richtige Stelle der ersten Tabelle (Oberbegriffe).
Schon mal danke für eure Hilfe.
Chris

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Chris,
ich konnte deine Beispieldatei wegen Link-Fehler nicht hochladen.
Hab dann mit Hilfe der Datei von Matze mal ein Makro erstellt.
Gruß
Franz

Sub BereichTransferieren()
Dim rngZiel As Range, rngZelle As Range, intOffset As Integer
Dim rngQuelle As Range
Dim varGruppe As Variant
Dim lngZeile As Long, lngSpalte As Long
With ActiveWorkbook.Worksheets("Tabelle1")
Set rngZiel = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
End With
With ActiveWorkbook.Worksheets("Tabelle2")
Set rngQuelle = .Range("L17:R24")
End With
Application.ScreenUpdating = False
For lngZeile = 1 To rngQuelle.Rows.Count
'Oberbegriff einlesen aus Blatt 2
varGruppe = rngQuelle.Cells(lngZeile, 1).Value
If varGruppe  "" Then
'Oberbegriff im Zielbereich suchen
Set rngZelle = rngZiel.Find(What:=varGruppe, LookIn:=xlValues, lookat:=xlWhole)
If Not rngZelle Is Nothing Then
'Werte zum Obergriff im Zielblatt eintragen
intOffset = 0
For lngSpalte = 2 To rngQuelle.Columns.Count
intOffset = intOffset + 1
rngZelle.Offset(0, intOffset).Value = rngQuelle.Cells(lngZeile, lngSpalte).Value
Next lngSpalte
End If
End If
Next lngZeile
Set rngZiel = Nothing: Set rngQuelle = Nothing: Set rngZelle = Nothing
Application.ScreenUpdating = True
End Sub

Beliebteste Forumthreads (12 Monate)

Tabelle kopieren und Inhalte anpassen

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

309 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Tabelle kopieren und Inhalte anpassen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

309 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread