Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro, Tabellenblätter vereinen als CSV-Datei

Makro, Tabellenblätter vereinen als CSV-Datei
31.01.2014 14:49:23
Tim
Hallo zusammen,
Aus einer Datei kann ich mittels Makro neue Tabellenblätter generieren ( Name des Tabellenblatts jeweils abhängig von Zellenwert), die alle die Spalten A,B und C gefüllt haben.
Ich möchte jetzt alle neu erzeugten Tabellenblätter zusammenführen, also die Inhalte der jeweiligen Spalten A,B und C in einer neuen Tabelle einer neuen Arbeitsmappe untereinander kopiert haben und als CSV (Trennzeichen getrennt)-Datei speichern. Der Speicherort soll frei wählbar sein, die Überschrift soll nur einmal kopiert und in A1,B1,C1 stehen.
Vielen Dank für Unterstützung!

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro, Tabellenblätter vereinen als CSV-Datei
01.02.2014 05:07:20
fcs
Hallo Tim,
hier zwei Makro-Variationen, die die Funktionalität haben.
Gruß
Franz
Sub Alle_in_1_Blatt_plus_CSV()
'Daten aus Tabellenblättern in einer  Arbeitsmappe auf Baasis einer Namensliste in _
einem Tabellenblatt zusammenführen und als CSV speichern
Dim lngZeile As Long, lngZeileZ As Long
Dim wkbAktiv As Workbook, wks As Worksheet, wksListe As Worksheet
Dim wkbZiel As Workbook, wksZiel As Worksheet
Dim rngCopy As Range
Set wkbAktiv = ActiveWorkbook
Dim varName
Set wksListe = wkbAktiv.Worksheets("Blattliste") 'Tabelle mit den Blattnamen
With wksListe
'Liste der Blattnamen abarbeiten
For lngZeile = 3 To .Cells(.Rows.Count, 1).End(xlUp).Row
Set wks = wkbAktiv.Worksheets(wksListe.Cells(lngZeile, 1).Text)
If wkbZiel Is Nothing Then
'1. Blatt mit allen Daten in neue Mappe kopieren
wks.Copy
Set wkbZiel = ActiveWorkbook
Set wksZiel = wkbZiel.Sheets(1)
With wksZiel
.Name = "Alle_CSV"
'nächste nicht benutzte Zeile im Blatt
lngZeileZ = .UsedRange.Row + .UsedRange.Rows.Count
End With
Else
With wks
'Daten in Spalten A bis C ab Zeile 2 kopieren
Set rngCopy = .Range(.Cells(2, 1), _
.Cells(.UsedRange.Row + .UsedRange.Rows.Count - 1, 3))
End With
rngCopy.Copy wksZiel.Cells(lngZeileZ, 1)
'nächte Einfügezeile berechnen
lngZeileZ = lngZeileZ + rngCopy.Rows.Count
End If
Next
End With
wkbZiel.Activate
'Speichername auswählen/eingeben
varName = Application.GetSaveAsFilename( _
InitialFileName:="ALLE" & Format(Date, "YYYYMMDD"), _
Filefilter:="CSV-Datei (*.csv),*.csv", _
Title:="Bitte Name der CSV-Datei auswählen/eingeben")
If varName  False Then
Application.DisplayAlerts = False
wkbZiel.SaveAs Filename:=varName, FileFormat:=xlCSV, Local:=True, addtomru:=True
wkbZiel.Close savechanges:=False
Application.DisplayAlerts = True
End If
End Sub
Sub Alle_in_1_Blatt_plus_CSV_2()
'Daten aus Tabellenblättern in einer  Arbeitsmappe in _
einem Tabellenblatt zusammenführen und als CSV speichern
Dim lngZeileZ As Long
Dim wkbAktiv As Workbook, wks As Worksheet
Dim wkbZiel As Workbook, wksZiel As Worksheet
Dim rngCopy As Range
Set wkbAktiv = ActiveWorkbook
Dim varName
For Each wks In wkbAktiv.Worksheets
Select Case wks.Name
Case "Blattliste", "Muster"
'Daten aus diesen Blättern nicht mit kopieren
Case Else
If wkbZiel Is Nothing Then
'1. Blatt mit allen Daten in neue Mappe kopieren
wks.Copy
Set wkbZiel = ActiveWorkbook
Set wksZiel = wkbZiel.Sheets(1)
With wksZiel
.Name = "Alle_CSV"
'nächste nicht benutzte Zeile im Blatt
lngZeileZ = .UsedRange.Row + .UsedRange.Rows.Count
End With
Else
With wks
'Daten in Spalten A bis C ab Zeile 2 kopieren
Set rngCopy = .Range(.Cells(2, 1), _
.Cells(.UsedRange.Row + .UsedRange.Rows.Count - 1, 3))
End With
rngCopy.Copy wksZiel.Cells(lngZeileZ, 1)
'nächte Einfügezeile berechnen
lngZeileZ = lngZeileZ + rngCopy.Rows.Count
End If
End Select
Next
wkbZiel.Activate
'Speichername auswählen/eingeben
varName = Application.GetSaveAsFilename( _
InitialFileName:="ALLE" & Format(Date, "YYYYMMDD"), _
Filefilter:="CSV-Datei (*.csv),*.csv", _
Title:="Bitte Name der CSV-Datei auswählen/eingeben")
If varName  False Then
'Datei als CSV speichern und schliessen
wkbZiel.SaveAs Filename:=varName, FileFormat:=xlCSV, Local:=True, addtomru:=True
Application.DisplayAlerts = False
wkbZiel.Close savechanges:=False
Application.DisplayAlerts = True
End If
End Sub

Anzeige

320 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige