Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Zellbereich prüfen, ob Inhalt vorhanden ist

Zellbereich prüfen, ob Inhalt vorhanden ist
01.02.2017 07:31:27
Matze
Hallo,
ein paar grundlegende Erfahrungen mit VBA habe ich schon gemacht, so dass ich das ein oder andere Verstehe, wenn ich einen Code sehe. Zum selber programmieren ist es aber noch ein weiter Weg und hoffe so auf eure Hilfe.
Ich habe ein Makro, mit dem ich mehrere Tabellen in einer zusammenfasse. Die auszulesenden Dateien sind alle identisch aufgebaut.
Für das Auslesen und Zusammenfassen habe ich bereits im Netz einen Codeschnipsel von Jürgen Hennekes gefunden. Das funktioniert soweit auch ganz gut mit einer kleinen Ausnahme und hier hoffe ich auf eure Hilfe!
Teilweise ist in dem auszulesenden Tabellenblatt außer der Überschrift nichts eingetragen. Ist das der Fall kopiert mein Makro die Überschrift, obwohl der Bereich ausgeschlossen ist. Ich vermute das liegt daran, dass die letzte leere Zeile -1 gesucht wird.
Nun möchte ich gerne vor dem kopieren prüfen, ob überhautp ein Inhalt vorhanden ist.
Public Sub Daten_mehrerer_Dateien_zusammenfuehren()
'Code für ein allgemeines Modul
'Autor: Jürgen Hennekes
On Error GoTo errExit
Dim WBQ As Workbook
Dim WBZ As Workbook
Dim varDateien As Variant
Dim lngAnzahl As Long
Dim lngLastQ As Long
Set WBZ = ActiveWorkbook
'Altdaten auf Zielblatt löschen
WBZ.Worksheets(6).Range("A2:IV65536").Clear
'Tabellenblatt umbenennen
WBZ.Worksheets(6).Name = "Meldungen Kari"
varDateien = _
Application.GetOpenFilename("Datei (*.xl*),*.xl*", False, "Bitte gewünschte Datei(en) markieren" _
_
, False, True)
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
'Daten aus Arbeitsblatt 6 auslesen und in Arbeitsblatt 6 einsetzen (Kari)
For lngAnzahl = LBound(varDateien) To UBound(varDateien)
Set WBQ = Workbooks.Open(Filename:=varDateien(lngAnzahl))
lngLastQ = WBQ.Worksheets(6).Range("B65536").End(xlUp).Row
WBQ.Worksheets(6).Range("B5:N" & lngLastQ).Copy _
Destination:=WBZ.Worksheets(6).Range("A" & WBZ.Worksheets(6).Range("A65536").End(xlUp).Row +   _
_
1)
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

Ich hoffe das ist einigermaßen verständlich und freue mich auf eure Rückmeldungen.
Danke
Matze
Anzeige

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zellbereich prüfen, ob Inhalt vorhanden ist
01.02.2017 07:50:33
hary
Moin
Pruef ob lngLastQ groesser 5
gruss hary
AW: Zellbereich prüfen, ob Inhalt vorhanden ist
01.02.2017 08:37:33
Matze
Danke für die schnelle Rückmeldung. Mit >5 hat es bei nur einem Eintrag nicht funktioniert, >4 funktioniert.
Habe das nun folgendermaßen gelöst.
'Daten aus Arbeitsblatt 6 auslesen und in Arbeitsblatt 6 einsetzen (Kari)
For lngAnzahl = LBound(varDateien) To UBound(varDateien)
Set WBQ = Workbooks.Open(Filename:=varDateien(lngAnzahl))
lngLastQ = WBQ.Worksheets(6).Range("B65536").End(xlUp).Row
 If lngLastQ > 4 Then
WBQ.Worksheets(6).Range("B5:N" & lngLastQ).Copy _
Destination:=WBZ.Worksheets(6).Range("A" & WBZ.Worksheets(6).Range("A65536").End(xlUp).Row +  _
1)
WBQ.Close
Else
WBQ.Close
End If
Next
Ein erster kurzer Test war positiv.
Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

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