Microsoft Excel

Herbers Excel/VBA-Archiv

Alle Dateien im Ordner bearbeiten

Betrifft: Alle Dateien im Ordner bearbeiten von: Norbert
Geschrieben am: 14.09.2020 10:26:38

Hallo zusammen,

ich habe einen Task den ich jetzt schon seit längerer Zeit händisch mache ohne darüber nachzudenken.
Weil ich von euch hier immer gute Hilfe bekommen habe, kam mir die Idee, diese Aufgabe jetzt auch noch einmal zu automatisieren. Die Lösung ist bestimmt leicht aber der Effekt für mich riesig.

Ich habe einen Ordner mit Dateien. Die Dateien die im Dateinamen mit LEG beginnen, müssen von mir angepasst werden. In diese Dateien gehe ich rein, wähle das zweite Worksheet der Datei aus aus und füge in A1 "Person" und B1 "Mobil" ein. Außerdem kopiere ich die zweite Zeile aus dem Worksheet in das zweite Worksheet der Datei. Dann schließe ich und gehe zu der nächsten Datei und immer so weiter.

Kann mir damit jemand helfen? Man müsste wohl mit ThisPath durch den Ordner laufen und überprüfen, welche Datei mit LEG* beginnt um dann die Modifikation automatisiert vorzunehmen. Aber wie? Ist wirklich eine langweilige wiederkehrende Aufgabe, welche sicherlich mit VBA angenehmer ist, ich bekomme das nur leider nicht zusammen.

Ich bin für jede Hilfe sehr dankbar.

Beste Grüße

Norbert

Betrifft: AW: Alle Dateien im Ordner bearbeiten
von: Nepumuk
Geschrieben am: 14.09.2020 10:51:38

Hallo Norbert,

teste mal:

Option Explicit

Public Sub UpdateLEG()
    
    Dim strFilename As String
    Dim avntCopyValues As Variant
    Dim objWorkbook As Workbook
    
    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    avntCopyValues = Range("A2:B2").Value
    
    strFilename = Dir$(ThisWorkbook.Path & "\LEG*.xls*")
    
    Do Until strFilename = vbNullString
        
        Set objWorkbook = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & strFilename)
        
        With objWorkbook.Worksheets(2)
            
            .Range("A1:B1").Value = Array("Person", "Mobil")
            .Range("A2:B2").Value = avntCopyValues
            
        End With
        
        Call objWorkbook.Close(SaveChanges:=True)
        
        Set objWorkbook = Nothing
        
        strFilename = Dir$
        
    Loop
    
    With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Gruß
Nepumuk

Betrifft: AW: Alle Dateien im Ordner bearbeiten
von: Norbert
Geschrieben am: 14.09.2020 13:58:13

Hallo Nepumuk,

vielen lieben Dank, das Makro funktioniert und nimmt mir die händische Arbeit ab :- )
Eine Sache nur noch, die ich vergessen habe: Ich erstelle das zweite Worksheet in jeder Datei immer selbst händisch. Kann man im Code eine Anweisung geben, dass in der aktuellen Datei ein neues Worksheet mit dem Namen "Informationen" erstellt wird? Das müsste ja nur eine Anweisung sein, oder? Ich habe es selbst versucht, aber ich bekomme eine Fehlermeldung wegen dem Objekt.

Vielen Dank noch einmal!

Beste Grüße
Norbert

Betrifft: AW: Alle Dateien im Ordner bearbeiten
von: Nepumuk
Geschrieben am: 14.09.2020 14:05:26

Hallo Norbert,

so:

Option Explicit

Public Sub UpdateLEG()
    
    Dim strFilename As String
    Dim avntCopyValues As Variant
    Dim objWorkbook As Workbook
    Dim objWorksheet As Worksheet
    
    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    avntCopyValues = Range("A2:B2").Value
    
    strFilename = Dir$(ThisWorkbook.Path & "\LEG*.xls*")
    
    Do Until strFilename = vbNullString
        
        Set objWorkbook = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & strFilename)
        
        With objWorkbook
            
            Set objWorksheet = .Worksheets.Add(After:=.Worksheets(1))
            
        End With
        
        With objWorksheet
            
            .Range("A1:B1").Value = Array("Person", "Mobil")
            .Range("A2:B2").Value = avntCopyValues
            
        End With
        
        Call objWorkbook.Close(SaveChanges:=True)
        
        Set objWorksheet = Nothing
        Set objWorkbook = Nothing
        
        strFilename = Dir$
        
    Loop
    
    With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Gruß
Nepumuk

Betrifft: AW: Alle Dateien im Ordner bearbeiten
von: Norbert
Geschrieben am: 14.09.2020 14:38:00

Super genau so, vielen Dank!!!

Betrifft: AW: Alle Dateien im Ordner bearbeiten
von: Nepumuk
Geschrieben am: 14.09.2020 16:43:14

Hallo Norbert,

den Namen der Tabelle habe ich vergessen. Daher:

Option Explicit

Public Sub UpdateLEG()
    
    Dim strFilename As String
    Dim avntCopyValues As Variant
    Dim objWorkbook As Workbook
    Dim objWorksheet As Worksheet
    
    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    avntCopyValues = Range("A2:B2").Value
    
    strFilename = Dir$(ThisWorkbook.Path & "\LEG*.xls*")
    
    Do Until strFilename = vbNullString
        
        Set objWorkbook = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & strFilename)
        
        With objWorkbook
            
            Set objWorksheet = .Worksheets.Add(After:=.Worksheets(1))
            
        End With
        
        With objWorksheet
            
            .Name = "Informationen"
            
            .Range("A1:B1").Value = Array("Person", "Mobil")
            .Range("A2:B2").Value = avntCopyValues
            
        End With
        
        Call objWorkbook.Close(SaveChanges:=True)
        
        Set objWorksheet = Nothing
        Set objWorkbook = Nothing
        
        strFilename = Dir$
        
    Loop
    
    With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Gruß
Nepumuk

Beiträge aus dem Excel-Forum zum Thema "Alle Dateien im Ordner bearbeiten"