Makro Spalten kopieren + in neue Datei

Guten Tag,
ich versuche schon eine ganze Weile das Makro zu schreiben, stoße aber an meine Grenzen und bitte daher hier um Hilfe.
Ich habe eine Datei mit viele Spalten. Ich würde gerne die Datei nach bestimmten Spaltennamen durchsuchen lassen und diese ausgewählten Spalten in eine komplett neue Datei (am besten durch das Makro erstellt) einfügen lassen, sodass ich am Ende 1 neue Datei habe in der nur die "ausgewählten" (nach Name) Spalten vorkommen.
Aktuell verwende ich von diesen Code, der die Spalten (hier mit 3 Beispielen) richtig erfasst und in ein neues Sheet schreibt. Allerdings übernimmt es hier nur die Inhalte und nicht den Spaltennamen, was ich nicht verstehe. Zudem würde ich statt in ein neues Sheet lieber in eine neue Datei schreiben
"


Private Sub Workbook_Open()
Application.DisplayAlerts = False
Worksheets("Daten").Activate
maxRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
maxCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To maxCol
cHeader = ActiveSheet.Cells(1, i).Value
Select Case cHeader
Case "Anrede": cAnrede = i
Case "Nachname": cNachname = i
Case "Vorname": cVorname = i
End Select
Next i
Worksheets("OP1").Activate
actRow = 2
For i = 2 To maxRow
actRow = actRow + 1
If (cAnrede) Then
If (Worksheets("Daten").Cells(i, cAnrede).Formula  "") Then
ActiveSheet.Cells(actRow, 1).Value = Worksheets("Daten").Cells(i, cAnrede).Formula
End If
End If
If (cUhrzeit) Then
If (Worksheets("Daten").Cells(i, cNachname).Formula  "") Then
ActiveSheet.Cells(actRow, 2).Value = Worksheets("Daten").Cells(i, cNachname).Formula
End If
End If
If (cVorname) Then
If (Worksheets("Daten").Cells(i, cVorname).Formula  "") Then
ActiveSheet.Cells(actRow, 3).Value = Worksheets("Daten").Cells(i, cVorname).Formula
End If
End If
Next i
Application.DisplayAlerts = True
End Sub

"
Kann mir damit jemand weiterhelfen? Ich wäre sehr dankbar
Mit freundlichen Grüßen
Frank

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Yal,
generell ein guter Vorschlag. Das Problem ist aber, dass ich nicht nach Spaltennummerierung löschen möchte, sondern nach dem Variablenname, da im Verlauf weitere Variablen hinzugefügt und entfernt werden und sich somit die Position der Variable in der Datei immer wieder verschieben wird. Mit dem obigen Code funktioniert das nur bleibt das Problem, dass es nicht die oberste Zeile (mit dem Namen der Variable) übernimmt, sondern nur deren Inhalt.
Ich komme auch immer mehr ab von der Idee, dass direkt in eine neue Datei zu überschreiben, sondern bei der Variante auf neues Blatt und dann das alte Blatt löschen (das habe ich hinbekommen).
Kann mir jemand sagen, ob ich mit einer kleinen Änderung des Codes die erste Zeile (Variablenname) in die Übertragung mit einbeziehen kann?
Liebe Grüße
Frank

Private Sub Workbook_Open() Dim ws As Worksheet, i As Long, raWeg As Range For Each ws In ThisWorkbook.Worksheets If ws.Name = "Daten" Then With ws For i = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column Select Case .Cells(1, i) Case "Anrede", "Nachname", "Vorname", "Uhrzeit" If .Cells(2, i) "" Then If raWeg Is Nothing Then Set raWeg = .Cells(1, i) Else Set raWeg = Union(raWeg, .Cells(1, i)) End If End If Case Else End Select Next i If Not raWeg Is Nothing Then raWeg.EntireColumn.Copy Worksheets("OP1").Range("A1").PasteSpecial _ Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False Application.DisplayAlerts = False End If Application.DisplayAlerts = False .Delete Exit For End With Else MsgBox "Es ist kein Blatt Daten vorhanden." End If Next ws Set raWeg = Nothing End Sub

Sub Blatt_kopierenUndLöschen() Dim W As Worksheet Dim C As Long Sheets("Daten").Copy After:=Sheets.Count Set W = ActiveSheet Set W.Name = "Daten_neu" For C = W.Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1 Select Case LCase(W.Cells(1, C)) 'Vergleich in lowercase Case "anrede", "vorname", "nachname" 'in dem Fall wird nichts gelöscht Case Else W.Cells(1, C).EntireColumn.Delete End Select Next End Sub

Beliebteste Forumthreads (12 Monate)

Makro Spalten kopieren + in neue Datei

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makro Spalten kopieren + in neue Datei

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread