Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1616to1620
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

ausgewählte Spalten kopieren aus mehreren Tabellen

ausgewählte Spalten kopieren aus mehreren Tabellen
06.04.2018 12:48:13
Selina
Hallo,
ich habe eine Tabelle in der in Spalte 1 verschiedene Dateinamen aufgelistet sind.("2018_01.csv", "2018_02.csv", "2018_03.csv")
Diese sollen nacheinander geöffnet werden. Dann sollen bestimmte Spalten aus der geöffneten Datei in eine neue Datei geschrieben werden.
Beide Funktionen funktionieren alleine wunderbar. Ich kann in einer csv.-Datei die Spalten auslesen, die ich brauch und ich kann mit der anderen Funktion nacheinander die Dateien öffnen und schließen. (Aber nur wenn die jeweils andere Funktion nicht vorhanden ist) Jetzt ist mein Problem, wie ich die Datei öffne, dann die Funktion ausführe um die Spalten zu kopieren, die Datei schließe und die nächste Datei öffne, etc.
Außerdem haben alle Dateien einen anderen Tabellennamen...evtl anstatt mit Workbook mit Worksheets arbeiten...?
Hoffe ihr könnte mir helfen!
Vielen Dank
Selina
Sub csv_export()
Dim strPfad As String
Dim rFile As Range
Dim blnOpen As Boolean
Dim csvCopy As Variant
strPfad = ThisWorkbook.Path
' ersten Dateinamen auswählen
Set rFile = ThisWorkbook.Sheets("Tabelle1").Range("A1")
' Funktion zum Tabellen öffnen aufrufen
Do While rFile.Value  ""
blnOpen = False
If Not WBOpen(rFile.Value) Then
blnOpen = True
Workbooks.Open strPfad & "\" & rFile.Value
End If
' für jede geöffnete Tabelle Funktion Spalten kopieren aufrufen
csvCopy = CopyColoumns(varSpalten)
' Speicherort abfragen
strSpeicherpfad = InputBox("Bitte den Namen der CSV-Datei angeben", "CSV-Export",  _
strMappenpfad)
' Neue Mappe als CSV Speichern
ActiveWorkbook.SaveAs strSpeicherpfad, FileFormat:=xlCSV, Local:=True
MsgBox "Export erfolgreich. Datei wurde exportiert nach" & vbNewLine & strSpeicherpfad
Set rFile = rFile.Offset(1, 0)
Loop
End Sub
' *********************************************************
' Tabellen öffnen
Function WBOpen(ByVal n As String) As Boolean
Dim wb As Workbook
For Each wb In Application.Workbooks
If UCase(wb.Name) = UCase(n) Then
WBOpen = True
Exit Function
End If
Next wb
End Function
' *********************************************************
' Spalten kopieren
Function CopyColoumns(varSpalten As Variant)
Dim intSpalte As Integer
Dim objQuelle As Object
Dim objZiel As Object
Dim strSpeicherpfad As String
Dim strMappenpfad As String
strMappenpfad = ActiveWorkbook.FullName
' Datenquelle festlegen
Set objQuelle = ThisWorkbook.Sheets("2018_01")  ' jede Datei hat einen anderen  _
Tabellennamen....muss geändert werden
' Neue CSV zum kopieren der Spalte erstellen
Set objZiel = ThisWorkbook.Sheets.Add
varSpalten = Array("N", "B", "C") ' zu speichernde Spalten in Reihenfolge
For intSpalte = 0 To UBound(varSpalten)
' zu speichernde Spalten in neue CSV kopieren
objQuelle.Cells(1, varSpalten(intSpalte)).EntireColoumn.Copy _
Destination:=objZiel.Cells(1, Coloumns.Count).End(xlToLeft).Offset(0, 1)
Next intSpalte
' erste Spalte löschen, weil leer
objZiel.Coloums(1).Delete
' kopierte Daten in neue CSV schreiben
objZiel.Move
End Function

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: ausgewählte Spalten kopieren
06.04.2018 13:31:11
Rudi
Hallo,
wie kommst du auf die Idee, das mit ner

Function zu machen? Functions sollen Werte zurückgeben und keine Aktionen ausführen.

Sub csv_export()
Dim strPfad As String
Dim rFile As Range
Dim strSpeicherPfad As String
Dim wkbQ As Workbook
Dim varSpalten As Variant, intSpalte As Integer
strPfad = ThisWorkbook.Path
Dim wksZiel As Worksheet
varSpalten = Array(14, 2, 3)
' ersten Dateinamen auswählen
Set rFile = ThisWorkbook.Sheets("Tabelle1").Range("A1")
' Funktion zum Tabellen öffnen aufrufen
Do While rFile  ""
If Not WBOpen(rFile) Then
Set wkbQ = Workbooks.Open(strPfad & "\" & rFile)
End If
' für jede geöffnete Tabelle Funktion Spalten kopieren aufrufen
Set wksZiel = ThisWorkbook.Worksheets.Add
For intSpalte = 0 To UBound(varSpalten)
wkbQ.Sheets(1).Columns(varSpalten(intSpalte)).Copy wksZiel.Cells(1, intSpalte + 1)
Next intSpalte
wkbQ.Close False  'Quellmappe schließen
wksZiel.Move  'Zielblatt in neue Mappe
'Dateiname abfragen
strSpeicherPfad = InputBox("Bitte den Namen der CSV-Datei angeben", "CSV-Export", wkbQ. _
Path)
With wksZiel.Parent
' Neue Mappe als CSV Speichern
.SaveAs strSpeicherPfad, FileFormat:=xlCSV, Local:=True
.Close False
End With
MsgBox "Export erfolgreich. Datei wurde exportiert nach" & vbNewLine & strSpeicherPfad
Set rFile = rFile.Offset(1, 0)
Loop
End Sub

Anzeige
AW: ausgewählte Spalten kopieren
06.04.2018 19:35:10
Selina
Hallo Rudi!
Danke, für die Antwort.
Ist tatsächlich viel logischer als meins :D Bin noch ein VBA Newbie und dachte evtl. werden in der Funktion ja dann die kopierten Werte zurückgegeben.... :-/
Bin jetzt noch auf Fehlersuche in diesem Teil des Codes:
For intSpalte = 0 To UBound(varSpalten)
wkbQ.Sheets(1).Columns(varSpalten(intSpalte)).Copy wksZiel.Cells(1, intSpalte + 1)
Next intSpalte
Da kommt im Moment noch ein Laufzeitfehler "Objekt erforderlich"
Wenn du mir nochmal helfen könntest, wär super! Ich würde Stunden dafür brauchen und dabei nicht mal was lernen
Anzeige
AW: ausgewählte Spalten kopieren
06.04.2018 19:38:53
Selina
Hat sich grade erledigt...Buchstabendreher...
Jetzt krieg ich an der Stelle aber die Meldung: Objektvariable oder WIth-Blockvariable nicht festgelegt...
AW: ausgewählte Spalten kopieren
06.04.2018 19:38:53
Selina
Hat sich grade erledigt...Buchstabendreher...
Jetzt krieg ich an der Stelle aber die Meldung: Objektvariable oder WIth-Blockvariable nicht festgelegt...
AW: ausgewählte Spalten kopieren aus mehreren Tabellen
10.04.2018 11:34:40
Selina
Hänge leider immer noch =(

322 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige