Code:
Option Explicit
Dim Arbeitspfad As String
Dim AktuellesWorkbook As String
Dim WorkbookDatenquelle As String
Dim AktuellesBlatt As String
Sub BerechnungKanal1()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Arbeitspfad = ThisWorkbook.Path
AktuellesWorkbook = ActiveWorkbook.Name
AktuellesBlatt = ActiveSheet.Name
For k = 1 To 50
'WorkbookDatenquelle = "2aXHzFFTVorlageBearbeitung.xlsm" 'Org
WorkbookDatenquelle = "2a" & 5 * k & "HzFFTVorlageBearbeitung.xlsm"
k = k
For i = 1 To Workbooks.Count
If Workbooks(i).Name = WorkbookDatenquelle Then
Exit For
ElseIf i = Workbooks.Count Then
' Workbooks.Open Filename:=Arbeitspfad & "\2aXHzFFTVorlageBearbeitung.xlsm" 'org
Workbooks.Open Filename:=Arbeitspfad & "\2a" & 5 * k & "HzFFTVorlageBearbeitung.xlsm" 'Excelspreadsheet mit Makros
Workbooks(AktuellesWorkbook).Activate
End If
Next i
With Workbooks(AktuellesWorkbook).Worksheets(AktuellesBlatt)
Workbooks("2a" & 5 * k & "HzFFTVorlageBearbeitung").Worksheets("Messwerte").Cells(2, 10) = k * 5
'falls Blatt aktualisiert wird
.Cells(1, (i - 1) * 3 + 2) = k * 5
For j = 1 To 10
.Cells(j + 3, 2) = Workbooks("2a" & 5 * k & "HzFFTVorlageBearbeitung").Worksheets("Messwerte").Cells(j + 7, 10)
.Cells(j + 3, 3) = Workbooks("2a" & 5 * k & "HzFFTVorlageBearbeitung").Worksheets("Messwerte").Cells(j + 7, 12)
.Cells(j + 3, 4) = Workbooks("2a" & 5 * k & "HzFFTVorlageBearbeitung").Worksheets("Messwerte").Cells(j + 7, 13)
Next j
For j = 13 To 14
.Cells(j + 3, 2) = Workbooks("2a" & 5 * k & "HzFFTVorlageBearbeitung").Worksheets("Messwerte").Cells(j + 7, 10)
.Cells(j + 3, 3) = Workbooks("2a" & 5 * k & "HzFFTVorlageBearbeitung").Worksheets("Messwerte").Cells(j + 7, 12)
.Cells(j + 3, 4) = Workbooks("2a" & 5 * k & "HzFFTVorlageBearbeitung").Worksheets("Messwerte").Cells(j + 7, 13)
Next j
For j = 17 To 18
.Cells(j + 3, 2) = Workbooks("2a" & 5 * k & "HzFFTVorlageBearbeitung").Worksheets("Messwerte").Cells(j + 7, 10)
.Cells(j + 3, 3) = Workbooks("2a" & 5 * k & "HzFFTVorlageBearbeitung").Worksheets("Messwerte").Cells(j + 7, 12)
.Cells(j + 3, 4) = Workbooks("2a" & 5 * k & "HzFFTVorlageBearbeitung").Worksheets("Messwerte").Cells(j + 7, 13)
Next j
For j = 22 To 31
.Cells(j + 3, 2) = Workbooks("2a" & 5 * k & "HzFFTVorlageBearbeitung").Worksheets("Messwerte").Cells(j + 7, 10)
.Cells(j + 3, 3) = Workbooks("2a" & 5 * k & "HzFFTVorlageBearbeitung").Worksheets("Messwerte").Cells(j + 7, 12)
.Cells(j + 3, 4) = Workbooks("2a" & 5 * k & "HzFFTVorlageBearbeitung").Worksheets("Messwerte").Cells(j + 7, 13)
Next j
For j = 33 To 42
.Cells(j + 3, 2) = Workbooks("2a" & 5 * k & "HzFFTVorlageBearbeitung").Worksheets("Messwerte").Cells(j + 7, 10)
.Cells(j + 3, 3) = Workbooks("2a" & 5 * k & "HzFFTVorlageBearbeitung").Worksheets("Messwerte").Cells(j + 7, 12)
.Cells(j + 3, 4) = Workbooks("2a" & 5 * k & "HzFFTVorlageBearbeitung").Worksheets("Messwerte").Cells(j + 7, 13)
Next j
For j = 45 To 47
.Cells(j + 3, 2) = Workbooks("2a" & 5 * k & "HzFFTVorlageBearbeitung").Worksheets("Messwerte").Cells(j + 7, 10)
.Cells(j + 3, 3) = Workbooks("2a" & 5 * k & "HzFFTVorlageBearbeitung").Worksheets("Messwerte").Cells(j + 7, 12)
.Cells(j + 3, 4) = Workbooks("2a" & 5 * k & "HzFFTVorlageBearbeitung").Worksheets("Messwerte").Cells(j + 7, 13)
Next j
End With
Workbooks("2a" & 5 * k & "HzFFTVorlageBearbeitung.xlsm").Save
Workbooks("2a" & 5 * k & "HzFFTVorlageBearbeitung.xlsm").Close
Next k
End Sub
Hier mein Code.
Für k werden oben bis zu 50 Dateien geöffnet und unten wieder geschlossen.
Es kann allerdings sein, dass es absichtlich gar nicht 50, sondern eben nur 30 gibt und die restlichen 20 "k" einfach übersprungen werden sollen. An der Stelle stoppt Excel aber das Makro und bietet mir nur die Möglichkeit, den Prozess komplett zu beenden, oder zu debuggen.