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

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

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

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!!

Anzeige
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

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 :-))
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige