KKleinste

[tw3aker]

Hallo, wenn das so ist, werden die Tabellenblätter fortgeschrieben oder immer wieder neu beschrieben..? Die Daten wären dann weg, oder sie müssten per VBA ins andere Blatt

Jeden tag in ein neues Blanco. dort noch ein mal bearbeitet und dann automatisiert via VBA und dritter Datei abgerufen.

Code:

Sub Lese()

Dim intBereich As Integer
Dim intZeile As Integer
Dim intSpalte As Integer
Dim strDatei As String
Dim intAnzVerz  As Integer
Dim intAktVerz  As Integer
Dim intAktBlatt As Integer
Dim intAktZeile As Integer
Dim intAktSpalte As Integer
Dim intSpDatum As Integer
Dim intSpBlatt As Integer
Dim intSpDatei As Integer
Dim intSpVerz As Integer
Dim strVerz As String
Dim strVerzA() As String
Dim varDatum As Variant
Dim varKopie As Variant
Dim varRngKopie As Variant
Dim bolLeer As Boolean
Dim rngAusgabe As Range
Dim wbLesen As Workbook
Dim wsLesen As Worksheet

Const intMaxVerz As Integer = 30
Const intMaxblatt As Integer = 2
Const strTeilDatei As String = ".xlsx"
Const strRngDatum As String = "C2"
Const strRngKopie As String = "B3:J55"
Const bolZeigVerz As Boolean = False
Const bolZeigDatei As Boolean = False
Const bolZeigBlatt As Boolean = False
Const bolZeigLeer As Boolean = True


Application.ScreenUpdating = False
'----------------------------------------------------
' Spalten für Verzeichnis, Datei und Blatt einrichten
'----------------------------------------------------
intSpDatum = 0
intSpBlatt = 0
intSpDatei = 0
intSpVerz = 0
If bolZeigBlatt Then
   intSpDatum = intSpDatum + 1
End If
If bolZeigDatei Then
   intSpDatum = intSpDatum + 1
   intSpBlatt = intSpBlatt + 1
End If
If bolZeigVerz Then
   intSpDatum = intSpDatum + 1
   intSpBlatt = intSpBlatt + 1
   intSpDatei = intSpDatei + 1
End If
varRngKopie = Split(strRngKopie)

'----------------------------------------------------
' Verzeichniseinlesen und Variablen initialisieren
'----------------------------------------------------

ReDim strVerzA(intMaxVerz)
intAktVerz = 1
intAnzVerz = 1
intAktZeile = 0
strVerzA(intAnzVerz) = ThisWorkbook.Names("Verzeichnis").RefersToRange
Set rngAusgabe = ThisWorkbook.Worksheets("Füllung").Cells(3, 1)
'Set rngAusgabe = ThisWorkbook.Names("Ausfüllen").RefersToRange

'----------------------------------------------------
' Schleife über Verzeichnisse
'----------------------------------------------------
While intAktVerz <= intAktVerz And intAktVerz <= intMaxVerz
   strVerz = strVerzA(intAktVerz)
   strDatei = Dir(strVerz, vbDirectory)
'----------------------------------------------------
' Schleife über Dateien im Verzeichnis
'----------------------------------------------------
   While strDatei <> ""
       If (GetAttr(strVerz & strDatei) And vbDirectory) = vbDirectory Then
           If strDatei <> "." And strDatei <> ".." And strDatei <> "" And intAnzVerz < intMaxVerz Then
               intAnzVerz = intAnzVerz + 1
               strVerzA(intAnzVerz) = strVerz & strDatei & "\"
           End If
       Else
           If InStr(strDatei, strTeilDatei) > 0 And strDatei <> ThisWorkbook.Name Then
               intAktBlatt = 0
               Set wbLesen = Workbooks.Open(Filename:=strVerz & strDatei, ReadOnly:=True)
               For Each wsLesen In wbLesen.Worksheets
                   intAktBlatt = intAktBlatt + 1
                   If intAktBlatt <= intMaxblatt Then
                       varDatum = wsLesen.Range(strRngDatum)
                       For intBereich = 0 To UBound(varRngKopie)
                           varKopie = wsLesen.Range(varRngKopie(intBereich)).Value
                           For intZeile = 1 To UBound(varKopie, 1)
'----------------------------------------------------
' Prüfen ob Werte leer
'----------------------------------------------------
                               If bolZeigLeer Then
                                   bolLeer = False
                               Else
                                   bolLeer = True
                                   For intSpalte = 1 To UBound(varKopie, 2)
                                       If varKopie(intZeile, intSpalte) <> "" Then
                                           bolLeer = False
                                       End If
                                   Next intSpalte
                               End If
'----------------------------------------------------
' Schreiben wenn nicht leer
'----------------------------------------------------
                               If Not bolLeer Then
                                   For intSpalte = 1 To UBound(varKopie, 2)
                                       rngAusgabe.Offset(intAktZeile, intSpalte + intSpDatum).Value = varKopie(intZeile, intSpalte)
                                   Next intSpalte
                                   rngAusgabe.Offset(intAktZeile, intSpVerz).Value = strVerz
                                   rngAusgabe.Offset(intAktZeile, intSpDatei).Value = strDatei
                                   rngAusgabe.Offset(intAktZeile, intSpBlatt).Value = wsLesen.Name
                                   rngAusgabe.Offset(intAktZeile, intSpDatum).Value = varDatum
                                   intAktZeile = intAktZeile + 1
                               End If
                           Next intZeile
                       Next intBereich
                   End If
               Next wsLesen
               wbLesen.Close savechanges:=False
           End If
       End If
   strDatei = Dir()
   Wend
   intAktVerz = intAktVerz + 1
Wend
Application.ScreenUpdating = True
End Sub

Mit der Script rufe ich eben ab.

ggf. kann man diese anpassen, dass sie nur Neuerungen listet oder das was abgerufen wird an vorhandene liste abgleicht und nur Neuerungen anfügt.

Danke und Gruß

[Jockel]

Jeden tag in ein neues Blanco. dort noch ein mal bearbeitet und dann automatisiert via VBA und dritter Datei abgerufen.
...
Danke und Gruß

Hallo, dass es um VBA geht hätte man in den Ausgangspost schreiben können...!!! Da kann ich eh nicht helfen...

[WillWissen]

Hi,

Auf alle Fälle muss ich das anpassen und ändern, da die aktuelle Lösung nicht optimal ist und nur noch bedingt funktioniert.

wenn du eh schon am Optimieren bist, dann stelle deine Datei doch wirklich bedienerfreundlich um. Vor allem mit den schon mehrfach genannten Tipps zur Excelkonformen Liste. Ich kann mir beim besten Willen nicht vorstellen, dass "Deutschland" dir vorschreibt, wie du deine Tabelle auszustatten hast. Du wirst sehen, dass du hinterher deine Auswertung, die du ja zusätzlich per Makro automatisieren kannst, ganz easy ist.
Allerdings werde ich mich jetzt ausklinken, da du schon hier mit VBA arbeitest und ich dir dabei mangels Wissen nicht helfen kann.

[shift-del]

Wenn die täglichen Dateien aufbewahrt werden dann könnte man auch mit Power Query arbeiten - vorausgesetzt es handelt sich um eine Excel-ProPlus-Version.