Spalten mit Namen XY markieren und kopieren

Hallo Zusammen,
ich habe eine Tabelle mit Spalten von A - ZZ. Ich möchte aber nur ein paar dieser Spalten nutzen und in ein neues Tabellenblatt kopieren.
Ich habe sowas schon einmal programmiert mit VBA und habe immer die Spalten angegeben A:B und J:K etc... Problem ist, die Tabelle bekomme ich regelmäßig und die Ersteller der Tabelle verändern dauernd etwas. Mal verschiebt sich der Ort der Spalte oder der Spaltenname ändert sich. An letzterem kann ich nichts ändern, da würde ich dann den VBA Code abändern...
Aber mein Plan sieht wie folgt aus:
Suche nach Spalte mit Spaltennamen = Jahr, markiere sie und kopiere sie in Tabellenblatt 2
Suche nach Spalte mit Spaltennamen = Betrag, markiere sie und kopiere sie in Tabellenblatt 2
usw usw.. Es sind ca 30 Spalten die ich brauche
Könnt ihr helfen? Ich habe sämtliche Einträge durchsuch, aber nie das passende gefunden. Es geht immer auf die Range mit den Spaltenbuchstaben. Ich muss aber nach der Überschrift suchen in Zeile 1 jeder Spalte.
VG
Sven

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Sven,
dann teste mal da hier:
Worksheets("Tabelle1") = das Blatt auf dem du die Spalten suchst
Worksheets("Tabelle2") in A1 bis A? deine Spaltenüberschriften die du suchst eintragen
Worksheets("Tabelle3") = das Zielblatt in das die Spalten kopiert werden.

Public Sub Spalten_suchen_kopieren()
Dim raFund As Range, raBereich As Range
Application.ScreenUpdating = False
'Blatt mit den Suchbegriffen
With Worksheets("Tabelle2")
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 1 To loLetzte
'Blatt in dem du die Spalten suchst
With Worksheets("Tabelle1")
Set raFund = .Cells.Find(what:=Worksheets("Tabelle2").Cells(i, 1), _
LookIn:=xlValues, lookat:=xlWhole)
If Not raFund Is Nothing Then
'Worksheets("Tabelle3") ist das Zielblatt
.Range(.Cells(raFund.Row, raFund.Column), .Cells(.Rows.Count, _
raFund.Column).End(xlUp)).Copy Worksheets("Tabelle3").Cells(1, i)
End If
End With
Next i
End With
End Sub

Gruß Werner

Option Explicit Public Sub Spalten_suchen_kopieren() Dim raFund As Range, raBereich As Range Dim loLetzte As Long, i As Long Application.ScreenUpdating = False 'Blatt mit den Suchbegriffen With Worksheets("Tabelle2") loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row For i = 1 To loLetzte 'Blatt in dem du die Spalten suchst With Worksheets("Tabelle1") Set raFund = .Cells.Find(what:=Worksheets("Tabelle2").Cells(i, 1), _ LookIn:=xlValues, lookat:=xlWhole) If Not raFund Is Nothing Then 'Worksheets("Tabelle3") ist das Zielblatt .Range(.Cells(raFund.Row, raFund.Column), .Cells(.Rows.Count, _ raFund.Column).End(xlUp)).Copy Worksheets("Tabelle3").Cells(1, i) End If End With Next i End With End Sub

Beliebteste Forumthreads (12 Monate)

Spalten mit Namen XY markieren und kopieren

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Spalten mit Namen XY markieren und kopieren

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread