Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1704to1708
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

Tabellenblätter mit gleichem Namen zusammenführen

Tabellenblätter mit gleichem Namen zusammenführen
13.08.2019 14:09:36
Liebold
Hallo ihr lieben,
Ich bin blutiger Anfänger bei VBA und habe mir mit Mühe folgendes Skript aus Vorlagen zusammengebastelt. Und zwar führe ich mit folgendem Code aus mehreren Dateien das erste Tabellenblatt zusammen in eine neue Datei:
_________________________________________________________________________________
Option Explicit
Sub ZUsammenführen()
Dim i               As Long
Dim sPfad           As String
Dim sDatei          As String
Dim vFileToOpen     As Variant
Dim lngLZ           As Long
Dim blnÜberschrift  As Boolean
Dim iCalc           As Integer
vFileToOpen = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , , , True)
If Not IsArray(vFileToOpen) Then Exit Sub
iCalc = Application.Calculation
On Error GoTo ENDE:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
For i = 1 To UBound(vFileToOpen)
sDatei = Dir(vFileToOpen(i))
sPfad = Left(vFileToOpen(i), InStr(vFileToOpen(i), sDatei) - 1)
With Tabelle1.Range("A1")
.Formula = "=LOOKUP(2,1/('" & sPfad & "[" & sDatei & "]Tabelle1'!$A:$A""""),ROW('" _
_
& sPfad & "\[" & sDatei & "]Tabelle1'!$A:$A))"
lngLZ = .Value
End With
With Tabelle1
If blnÜberschrift Then
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(lngLZ - 1, 10).Formula = _
"='" & sPfad & "[" & sDatei & "]Tabelle1'!A2"
Else
blnÜberschrift = True
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(lngLZ, 10).Formula = _
"='" & sPfad & "[" & sDatei & "]Tabelle1'!A1"
End If
End With
Call StatusBalken(Int((i / UBound(vFileToOpen)) * 100))
Next
With Tabelle1.UsedRange
.Copy
.PasteSpecial xlPasteValues
.Rows(1).Delete
End With
ENDE:
Application.EnableEvents = True
Application.Calculation = iCalc
Application.ScreenUpdating = True
If Err Then MsgBox Err.Description, , "Fehler: " & Err
End Sub
Sub StatusBalken(ProzentSatz) ''ProzentSatz = Int((i / 10000) * 100)
Dim Mess, Z, Rest
Static oldStatusBar As Integer
Static blnInit As Boolean
If Not blnInit Then
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
End If
Mess = ""
For Z = 1 To ProzentSatz
Mess = Mess & ChrW(Val("&H25A0"))
Next Z
Rest = 100 - ProzentSatz
For Z = 1 To Rest
Mess = Mess & ChrW(Val("&H25A1"))
Next Z
Application.StatusBar = Mess & " " & ProzentSatz & "%"
If Rest 
________________________________________________________________________________
Nun zu meiner Frage:
Wie kann ich speziell die Tabellenblätter mit dem Namen "Plants" ansprechen? Also dass nicht aus jeder Datei automatisch Tabellenblatt 1 übernommen wird, sondern das Tabellenblatt mit dem Namen "Plants".
Vielen Dank und beste Grüße,
Anna

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

Betreff
Datum
Anwender
Anzeige
AW: Tabellenblätter mit gleichem Namen zusammenführen
13.08.2019 14:53:17
Pierre
Hallo Anna,
ich rate mal:
Statt

With Tabelle1
versuch mal

With Worksheets("Plants")
Gruß Pierre
AW: Tabellenblätter mit gleichem Namen zusammenführen
13.08.2019 15:01:45
Liebold
Hi Pierre,
danke für den Versuch:)
Das funktioniert auch überall, nur dort nicht, wo er eben genau das bestimmte Tabellenblatt auswählen soll, also hier:
.Formula = "=LOOKUP(2,1/('" & sPfad & "[" & sDatei & "]Tabelle1'!$A:$A""""),ROW('" __& sPfad & "\[" & sDatei & "]Tabelle1'!$A:$A))
Da wird eine Fehlermeldung angezeigt, wenn ich aus Tabelle 1 Worksheets("Plants") machen möchte.
Gruß, Anna
Anzeige
AW: Tabellenblätter mit gleichem Namen zusammenführen
13.08.2019 15:04:33
Daniel
Da schreibst du ja auch eine Formel und keinen Code.
Versuche Plants'!$A:$A...
Gruß
Daniel
AW: Tabellenblätter mit gleichem Namen zusammenführen
13.08.2019 15:26:57
Liebold
Super, danke dir!
Nun noch zwei Fragen:
- Ich möchte nicht nur den Inhalt, sondern auch die Formatierung übernehmen. Und da eigentlich auch nur die Farbe der Zellen. Ist das möglich?
- In einigen Spalten sind erst ab Zeile 4 Einträge vorhanden. Dementsprechend soll einfach immer überprüft werden, ob in Zeile 4 Einträge vorhanden sind und wenn ja, soll die Spalte kopiert werden. Es ist wahrscheinlich super einfach, wenn man das komplette Skript versteht, aber leider fehlt es mir an einigen Stellen.
Anzeige
AW: Tabellenblätter mit gleichem Namen zusammenführen
13.08.2019 15:35:00
Daniel
Versuch mal unter deinem PasteSpecial noch eine Zeile
.PasteSpecial xlPasteFormats
einzufügen.
AW: Tabellenblätter mit gleichem Namen zusammenführen
13.08.2019 15:38:00
Liebold
Klappt leider nicht.. es werden noch immer nur die Werte kopiert.
AW: Tabellenblätter mit gleichem Namen zusammenführen
15.08.2019 10:47:18
Liebold
Hast du eine Idee, wieso das nicht funktioniert? Mein Code sieht jetzt so aus:
Option Explicit
Sub Zusammenführen()
Dim i               As Long
Dim sPfad           As String
Dim sDatei          As String
Dim vFileToOpen     As Variant
Dim lngLZ           As Long
Dim blnÜberschrift  As Boolean
Dim iCalc           As Integer
vFileToOpen = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , , , True)
If Not IsArray(vFileToOpen) Then Exit Sub
iCalc = Application.Calculation
On Error GoTo ENDE:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
For i = 1 To UBound(vFileToOpen)
sDatei = Dir(vFileToOpen(i))
sPfad = Left(vFileToOpen(i), InStr(vFileToOpen(i), sDatei) - 1)
With Sheets("Plants").Range("A1")
.Formula = "=LOOKUP(2,1/('" & sPfad & "[" & sDatei & "]Plants'!$A:$A""""),ROW('" & _
sPfad & "\[" & sDatei & "]Plants'!$A:$A))"
lngLZ = .Value
End With
With Sheets("Plants")
If blnÜberschrift Then
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(lngLZ - 1, 68).Formula = _
"='" & sPfad & "[" & sDatei & "]Plants'!A4"
Else
blnÜberschrift = True
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(lngLZ, 68).Formula = _
"='" & sPfad & "[" & sDatei & "]Plants'!A1"
End If
End With
Call StatusBalken(Int((i / UBound(vFileToOpen)) * 100))
Next
With Sheets("Plants").UsedRange
.Copy
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
.Rows(1).Delete
End With
ENDE:
Application.EnableEvents = True
Application.Calculation = iCalc
Application.ScreenUpdating = True
If Err Then MsgBox Err.Description, , "Fehler: " & Err
End Sub
Sub StatusBalken(ProzentSatz) ''ProzentSatz = Int((i / 10000) * 100)
Dim Mess, Z, Rest
Static oldStatusBar As Integer
Static blnInit As Boolean
If Not blnInit Then
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
End If
Mess = ""
For Z = 1 To ProzentSatz
Mess = Mess & ChrW(Val("&H25A0"))
Next Z
Rest = 100 - ProzentSatz
For Z = 1 To Rest
Mess = Mess & ChrW(Val("&H25A1"))
Next Z
Application.StatusBar = Mess & " " & ProzentSatz & "%"
If Rest 

Gruß, Anna
Anzeige
AW: Tabellenblätter mit gleichem Namen zusammenführen
13.08.2019 15:08:53
Pierre
Hi Anna,
ich übe ja auch noch :D
Innerhalb einer Formel reicht es ja prinzipiell aus, den Blattnamen zu schreiben.
In deinem Fall also statt Tabelle1 dann einfach nur Plants.
Aber ob das innerhalb eines Makros auch geht, weiß ich leider auch nicht.
Vielleicht tauschst du die beiden "Tabelle1" mal durch "Plants" (also ohne Worksheets davor).
Gruß Pierre
PS: Wahrscheinlich kommt gleich eh jemand mit einer vernünftigen Lösung um die Ecke ;)
AW: Tabellenblätter mit gleichem Namen zusammenführen
13.08.2019 15:28:57
Liebold
Vielen Dank! Hat geklappt:)
gerne! ...
13.08.2019 15:34:23
Pierre
... beim Rest bin ich aber raus. ;)

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige