Ich hab mir ein Makro gepastelt, dass ich nun für alle Dateien im Ornder anwenden möchte. Datei öffnen Makro ausführen, Datei schließen...
Ich habe schon etwas gesucht, aber irgendwie mag es nicht funktionieren.
Mein Makro bildet die Summe von verschiedenen Spalten. Die zu ausführenden Dateien sind alle gleich aufgebaut.
Aktuell habe ich folgenden Code:
Option Explicit
Const strPath As String = "C:\temp\Test\"
Sub Main()
Dim strDateiname As String
Dim wkbBook As Workbook
Dim lngLastRowQ As Long
Dim lngLastRowZ As Long
Dim lngLastCol As Long
Dim intCalc As Integer
On Error GoTo Fin
With Application
.ScreenUpdating = False
.AskToUpdateLinks = False
.EnableEvents = False
intCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
'strDateiname = Dir$(ThisWorkbook.Path & "\*.xls")
strDateiname = Dir$(strPath & "*.xlsx")
Do While strDateiname ""
If strDateiname ThisWorkbook.Name Then
Set wkbBook = Workbooks.Open(strPath & strDateiname)
' mein Code
Dim lngLetzteZeile As Long
Dim i As Integer
With Worksheets("Tabelle1")
For i = 14 To 88
lngLetzteZeile = .Cells(Rows.Count, i).End(xlUp).Row
'eine Zeile darunter die Summe eintragen:
.Cells(lngLetzteZeile + 1, i).FormulaR1C1 = "=SUM(R17C:R[-1]C)"
'kopieren
Sheets("Tabelle2").Cells(2, i - 13) = .Cells(lngLetzteZeile + 1, i)
Next
End With
' mein Code Ende
wkbBook.Close False ' Oder True, wenn gespeichert werden soll
Set wkbBook = Nothing
End If
strDateiname = Dir$()
Loop
Fin:
Set wkbBook = Nothing
With Application
.ScreenUpdating = True
.AskToUpdateLinks = True
.EnableEvents = True
.Calculation = intCalc
.DisplayAlerts = True
End With
If Err.Number 0 Then MsgBox "Error: " & _
Err.Number & " " & Err.Description
End Sub
Das Makro funktioniert irgendwie nur an der geöffneten Datei und dass macht er dafür 4x. Kann mir jemand helfen?
Grüße Marco