Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.10.2025 17:40:39
16.10.2025 17:25:38
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Brauche Hilfe zu fertigem Code

Forumthread: Brauche Hilfe zu fertigem Code

Brauche Hilfe zu fertigem Code
16.04.2013 17:30:12
Sylvia
Hallo zusammen, vielleicht kann mir jemand helfen einen bereits fertigen Code (gefunden auf der Seite des Erstellers)abzuwandeln? Ich muss aus vielen mehreren Dateien Sheets zusammenfassen, was dieser Code hervorragend löst. Jetzt müsste ich das Ganze nur so abändern dass ich Blätter mit dem Namen "Fremd" vom Einlesen ausschließen kann. Ich habe schon alles mögliche probiert, ich bekomms einfach nicht hin. Es werden entweder alle oder nichts eingelesen. Es wäre nett wenn mal jemand der Profis sich das ansehen könnte?
Public Sub Daten_mehrerer_Dateien_zusammenfuehren2()
'Code für ein allgemeines Modul
'Autor: Jürgen Hennekes
On Error GoTo errExit
Dim WBQ As Workbook
Dim WBZ As Workbook
Dim intSh As Integer
Dim varDateien As Variant
Dim lngAnzahl As Long
Dim lngLastQ As Long
Set WBZ = ActiveWorkbook
'Altdaten auf Zielblatt löschen
WBZ.Worksheets(1).Range("A1:IV65536").ClearContents
varDateien = _
Application.GetOpenFilename("Datei (*.xls),*.xls", False, "Bitte gewünschte Datei(en) markieren" _
_
, False, True)
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
For lngAnzahl = LBound(varDateien) To UBound(varDateien)
Set WBQ = Workbooks.Open(Filename:=varDateien(lngAnzahl))
For intSh = 1 To WBQ.Worksheets.Count
lngLastQ = WBQ.Worksheets(intSh).Range("A65536").End(xlUp).Row
WBQ.Worksheets(intSh).Range("A1:Z" & lngLastQ).Copy _
Destination:=WBZ.Worksheets(1).Range("A" & WBZ.Worksheets(1).Range("A65536").End(xlUp). _
Row + 1)
Next
WBQ.Close
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
MsgBox "Es wurden " & UBound(varDateien) & " Dateien zusammengefügt.", 64
Exit Sub
errExit:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
If Err.Number = 13 Then
MsgBox "Es wurde keine Datei ausgewählt"
Else
MsgBox "Es ist ein Fehler aufgetreten!" & vbCr _
& "Fehlernummer: " & Err.Number & vbCr _
& "Fehlerbeschreibung: " & Err.Description
End If
End Sub

Anzeige

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

Betreff
Datum
Anwender
Anzeige
If Worksheets(intsh).Name <> "Fremd" ...
16.04.2013 17:38:32
Matthias
Hallo
nicht getestet
also bitte an einer Kopie testen
'...
Set WBQ = Workbooks.Open(Filename:=varDateien(lngAnzahl))
For intsh = 1 To WBQ.Worksheets.Count
If Worksheets(intsh).Name  "Fremd" Then
lngLastQ = WBQ.Worksheets(intsh).Range("A65536").End(xlUp).Row
WBQ.Worksheets(intsh).Range("A1:Z" & lngLastQ).Copy _
Destination:=WBZ.Worksheets(1).Range("A" & WBZ.Worksheets(1).Range("A65536").End(xlUp).Row + 1)
End If
Next
'...
Gruß Matthias

Anzeige
AW: If Worksheets(intsh).Name <> "Fremd" ...
16.04.2013 17:46:40
Sylvia
So schnell und so perfekt! Habe alles mögliche mit "If" probiert, der Fehler lag bei
"Worksheets(intsh).Name ", das habe ich nicht richtig angegeben.
Vielen Dank!!

Danke für die Rückmeldung... kwT
16.04.2013 17:55:57
Matthias

AW: Brauche Hilfe zu fertigem Code
16.04.2013 17:41:40
hary
Hallo
Mach eine If abfrage rein.
Set WBQ = Workbooks.Open(Filename:=varDateien(lngAnzahl))
For intSh = 1 To WBQ.Worksheets.Count
If WBQ.Worksheets(intSh).Name  "Fremd" Then  'wenn Name nicht "Fremd"
lngLastQ = WBQ.Worksheets(intSh).Range("A65536").End(xlUp).Row
WBQ.Worksheets(intSh).Range("A1:Z" & lngLastQ).Copy _
Destination:=WBZ.Worksheets(1).Range("A" & WBZ.Worksheets(1).Range("A65536").End(xlUp). _
Row + 1)
End If
Next

gruss hary

Anzeige
AW: Brauche Hilfe zu fertigem Code
16.04.2013 17:51:22
Sylvia
@hary, danke, da war jemand schneller, nur meine Antwort war zu langsam :-))
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige