folgende Situation. Mit dem File System Object öffne und lese ich Exceldateien aus einem Verzeichnis.
Pro geöffnete Exceldatei werden Zellenwerte an mein programmausführendes Excelsheet übertragen.
Manche geöffneten Exceldateien enthalten Verknüpfungen, die ich automatisch aktualiseren lassen möchte. Anweisung ist folgende:
If Verknuepfung = True Then
Workbooks.Open Filename:=Fileitem.Path, UpdateLinks:=Verknuepfung
Else
Workbooks.Open Filename:=Fileitem.Path
End If
Problembeschreibung:
Die Function Getmorespeed() schaltet die Zellen- /Formelberechnung aus.
Dadurch wird das Prozedere "Das Einlesen von Daten aus n-Exceldateien während der Programmausführung" extrem beschleunigt, aber die Anweisung "Workbooks.Open Filename:=Fileitem.Path, UpdateLinks:= True" nur initiiert, aber nicht ausgeführt, weil ja zuvor
Application.Calculation deaktiviert wurde.
Wird Application.Calculation separat aktiviert, verlangsamt sich die Programmausführung dramatisch.
Um das zu Umgehen, habe ich mir folgendes ausgedacht:
1) Schritt: Über fso alle Exelfiles des vorher def. Verzeichnises öffnen, Verknüpfungen aktualisieren, speichern und schliessen.
2) Schritt: Nochmal über fso alle Excelfiles öffnen, dann aber nur die Zellenwerte auslesen und an das ausführende Excelsheet die Daten übertragen.
also 1) Daten der Exelfiles aktualisieren
2) Exeldaten der Exceldateien auf das Mastersheet übertragen
Gibt es eine bessere Alternative? Wie optimiere ich die Performance?
Sub GetMoreSpeed(bYesNo As Boolean)
'Ein- bzw. Ausschalten von Excel-Aktionen
'Bildschirmaktualisierung
Application.ScreenUpdating = Not (bYesNo)
'Excel-Aktion-Methoden
Application.EnableEvents = Not (bYesNo)
'Zellen- /Formelberechnung
Application.Calculation = IIf(bYesNo, xlCalculationManual, xlCalculationAutomatic)
End Sub
Sub Read(Verknuepfung As Boolean)
Dim SourceFolderName As String
SourceFolderName = CStr(ThisWorkbook.Worksheets("Optionen").Cells(1, 1).Value)
If SourceFolderName = "" Then
MsgBox "Start-Verzeichnis fehlt, bitte selektieren!"
Exit Sub
End If
'SourceFolderName = Left(ActiveWorkbook.Path, InStrRev(ActiveWorkbook.Path, "\") - 1)
'SourceFolderName = "U:\LLI_TD_Cost_Reduction_Proposal\Cost_Reduction_Proposal\ _
Aktuelle_Proposals"
'SourceFolderName = "U:\LLI_TD_Cost_Reduction_Proposal\Cost_Reduction_Proposal\ _
Aktuelle_Proposals\Aktuelle_Proposals_DA"
'SourceFolderName = "U:\LLI_TD_Cost_Reduction_Proposal\Cost_Reduction_Proposal\ _
Aktuelle_Proposals\Aktuelle_Proposals_DE"
'SourceFolderName = "U:\LLI_TD_Cost_Reduction_Proposal\Cost_Reduction_Proposal\ _
Aktuelle_Proposals\Aktuelle_Proposals_DH"
'SourceFolderName = "U:\LLI_TD_Cost_Reduction_Proposal\Cost_Reduction_Proposal\ _
Aktuelle_Proposals\Aktuelle_Proposals_DM"
'SourceFolderName = "U:\LLI_TD_Cost_Reduction_Proposal\Cost_Reduction_Proposal\ _
Aktuelle_Proposals\Aktuelle_Proposals_DM\Ausgabespecial"
'SourceFolderName = "U:\LLI_TD_Cost_Reduction_Proposal\Cost_Reduction_Background_Information\ _
Veraltete_oder_gelöschte_CRP_Issues\DM"
Call ListFilesInFolder(SourceFolderName, Verknuepfung)
End Sub
Sub ListFilesInFolder(SourceFolderName As String, Verknuepfung As Boolean)
Dim fso
Dim lngRow As Long
Dim Display, URL As String
Dim IncludeSubfolders As Boolean
Dim Blattschutz As Boolean
IncludeSubfolders = True
Set Ziel = ThisWorkbook.Worksheets("CRP_Datas")
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set Sourcefolder = fso.GetFolder(SourceFolderName)
Ziel.Select
lngRow = Range("A65536").End(xlUp).Row + 1
' For 1)
For Each Fileitem In Sourcefolder.Files
'if_1
If Right(Fileitem.Name, 3) = "xls" Then
'Worksheet CRP Datas Cin ("Biodaten einlesen")
' if_2
If InStr(Fileitem.Name, "CRP_Master") > 0 Then
lngRow = lngRow - 1
Else
'On Error Resume Next
If Verknuepfung = True Then
Workbooks.Open Filename:=Fileitem.Path, UpdateLinks:=Verknuepfung
Else
Workbooks.Open Filename:=Fileitem.Path
End If
Set Quelle = ActiveWorkbook.Worksheets("Deckblatt")
Set QuelleM = ActiveWorkbook.Worksheets("Mengengerüst NRC")
'******************** -Blattschutz- ********************
If Quelle.ProtectContents = True Then
Blattschutz = True
Quelle.Unprotect Password:="CRP"
Else
Blattschutz = False
End If
'if_3
'"CRP_Aktionen" = ActiveSheet.Name
If Quelle.Name = "Deckblatt" Then
'MsgBox Fileitem.Name
'if_4
If lngRow = 6 Then
Ziel.Cells(6, 1) = 1
Else
Ziel.Cells(lngRow, 1) = Ziel.Cells(lngRow - 1, 1).Value + 1
'if_4
End If
Ziel.Cells(lngRow, 2) = Quelle.Cells(5, 3) 'Title
Ziel.Cells(lngRow, 3) = Quelle.Cells(1, 6) 'Doc. No.
Ziel.Cells(lngRow, 4) = Quelle.Cells(2, 6) 'Issue
Ziel.Cells(lngRow, 5) = Fileitem.Name 'FileItem.Name
Ziel.Cells(lngRow, 6) = Quelle.Cells(3, 6) 'Originator
Ziel.Cells(lngRow, 7) = Quelle.Cells(3, 7) 'Organization
Ziel.Cells(lngRow, 8) = Quelle.Cells(4, 6) 'Date
Ziel.Cells(lngRow, 9) = Quelle.Cells(6, 3) 'Customer
Ziel.Cells(lngRow, 10) = Quelle.Cells(6, 6) 'Project
Ziel.Cells(lngRow, 11) = Quelle.Cells(7, 3) 'Name LRU
Ziel.Cells(lngRow, 12) = Quelle.Cells(8, 3) 'Part Number
Ziel.Cells(lngRow, 13) = Quelle.Cells(9, 3) 'Article Number
Ziel.Cells(lngRow, 14) = Quelle.Cells(7, 6) 'Name Piece Part
Ziel.Cells(lngRow, 15) = Quelle.Cells(8, 6) 'Part Number
Ziel.Cells(lngRow, 16) = Quelle.Cells(9, 6) 'Article Number
Ziel.Cells(lngRow, 17) = Quelle.Cells(10, 3) 'Make / Buy / Elongated Workbench
Ziel.Cells(lngRow, 18) = Quelle.Cells(10, 6) 'Development / Serialphase
Ziel.Cells(lngRow, 19) = Quelle.Cells(13, 3) 'Specification
Ziel.Cells(lngRow, 20) = Quelle.Cells(14, 3) 'Weights
Ziel.Cells(lngRow, 21) = Quelle.Cells(15, 3) 'Cost
Ziel.Cells(lngRow, 22) = Quelle.Cells(16, 3) 'Customer approval required
Ziel.Cells(lngRow, 22 + 1) = Quelle.Cells(17, 3) 'Two Way Interchangeability
Ziel.Cells(lngRow, 23 + 1) = Quelle.Cells(13, 6) 'Maintainability
Ziel.Cells(lngRow, 24 + 1) = Quelle.Cells(14, 6) 'Reliability
Ziel.Cells(lngRow, 25 + 1) = Quelle.Cells(15, 6) 'Certification
Ziel.Cells(lngRow, 26 + 1) = Quelle.Cells(16, 6) 'Qualificvation
Ziel.Cells(lngRow, 27 + 1) = Quelle.Cells(17, 6) 'Prod. Accpt. test
Ziel.Cells(lngRow, 28 + 1) = Quelle.Cells(18, 6) 'Tech. Documentation
Ziel.Cells(lngRow, 29 + 1) = Quelle.Cells(20, 6) 'per piece part EUR
Ziel.Cells(lngRow, 30 + 1) = Quelle.Cells(20, 7) 'per piece part %
Ziel.Cells(lngRow, 30 + 2) = Quelle.Cells(21, 6) 'per LRU
Ziel.Cells(lngRow, 31 + 2) = Quelle.Cells(22, 6) 'per AC
Ziel.Cells(lngRow, 32 + 2) = Quelle.Cells(22, 3) 'per Year[EURO]
Ziel.Cells(lngRow, 33 + 2) = Quelle.Cells(19, 3) 'NRC'S[EURO]
Ziel.Cells(lngRow, 34 + 2) = Quelle.Cells(24, 3) 'Start Investment
Ziel.Cells(lngRow, 35 + 2) = Quelle.Cells(26, 3) 'Duration Investment
Ziel.Cells(lngRow, 36 + 2) = Quelle.Cells(24, 6) 'Start Amortisation
Ziel.Cells(lngRow, 37 + 2) = Quelle.Cells(25, 6) 'End Amortisation
Ziel.Cells(lngRow, 38 + 2) = Quelle.Cells(26, 6) 'Duration Amortisation
Ziel.Cells(lngRow, 39 + 2) = Quelle.Cells(27, 3) 'Performance / Specification
Ziel.Cells(lngRow, 40 + 2) = Quelle.Cells(29, 3) 'Quality Management
Ziel.Cells(lngRow, 41 + 2) = Quelle.Cells(31, 3) 'Production
Ziel.Cells(lngRow, 42 + 2) = Quelle.Cells(33, 3) 'Quality Assurance
Ziel.Cells(lngRow, 43 + 2) = Quelle.Cells(35, 3) 'Commercial
Ziel.Cells(lngRow, 44 + 2) = Quelle.Cells(37, 3) 'Human Sourcing
Ziel.Cells(lngRow, 45 + 2) = Quelle.Cells(39, 3) 'CRP to be funded by AD
Ziel.Cells(lngRow, 46 + 2) = Quelle.Cells(40, 3) 'CRP to be cancelled
Ziel.Cells(lngRow, 47 + 2) = Quelle.Cells(39, 6) 'CRP to be postponded
Ziel.Cells(lngRow, 48 + 2) = Quelle.Cells(40, 6) 'if yes: re-initation on
Ziel.Cells(lngRow, 49 + 2) = Quelle.Cells(44, 6) 'Signature Date
'Task Administration
Ziel.Cells(lngRow, 51 + 1) = Quelle.Cells(46, 3) 'AD -Number
Ziel.Cells(lngRow, 52 + 1) = Quelle.Cells(46, 6) 'Sub-Number
Ziel.Cells(lngRow, 53 + 1) = Quelle.Cells(47, 3) 'Committed Project Start
Ziel.Cells(lngRow, 54 + 1) = Quelle.Cells(47, 6) 'Committed Project Ende
Ziel.Cells(lngRow, 55 + 1) = Quelle.Cells(48, 3) 'Comm.Responsible Name
Ziel.Cells(lngRow, 56 + 1) = Quelle.Cells(49, 3) 'Comm. Responsible Departm. Sign.
Ziel.Cells(lngRow, 57 + 1) = Quelle.Cells(49, 6) 'Comm.Date
Ziel.Cells(lngRow, 58 + 1) = Quelle.Cells(51, 6) 'Preliminary Customer Agreement _
assured
Ziel.Cells(lngRow, 59 + 1) = Quelle.Cells(52, 3) 'Performed Project Start
Ziel.Cells(lngRow, 60 + 1) = Quelle.Cells(52, 6) 'Performed Project Ende
Ziel.Cells(lngRow, 61 + 1) = Quelle.Cells(53, 3) 'Perf.Responsible Name
Ziel.Cells(lngRow, 62 + 1) = Quelle.Cells(54, 3) 'Perf. Responsible Departm.
Ziel.Cells(lngRow, 63 + 1) = Quelle.Cells(54, 6) 'Sign.Perf.Date
'Mengengerüst auslesen
If QuelleM.Name = "Mengengerüst NRC" Then
Ziel.Cells(lngRow, 65) = QuelleM.Cells(106, 3) 'HK Material
Ziel.Cells(lngRow, 66) = QuelleM.Cells(106, 4) 'HK Fremdleistg.
Ziel.Cells(lngRow, 67) = QuelleM.Cells(111, 5) 'Project Management
Ziel.Cells(lngRow, 68) = QuelleM.Cells(111, 6) 'Entwicklung Konstruktion
Ziel.Cells(lngRow, 69) = QuelleM.Cells(111, 7) 'System-Ausl. Theorie
Ziel.Cells(lngRow, 70) = QuelleM.Cells(111, 8) 'Qualification Test
Ziel.Cells(lngRow, 71) = QuelleM.Cells(111, 9) 'Qualitätssicherung
Ziel.Cells(lngRow, 72) = QuelleM.Cells(111, 10) 'Arbeitsvorb. Fertigung
Ziel.Cells(lngRow, 73) = QuelleM.Cells(111, 11) 'Customer Service
Ziel.Cells(lngRow, 74) = QuelleM.Cells(106, 12) 'Anlagekosten Fremdl.
Ziel.Cells(lngRow, 75) = QuelleM.Cells(106, 13) 'Sonstiges Fremdl.
End If
Display = Ziel.Cells(lngRow, 3).Value
URL = Fileitem.Path
Ziel.Hyperlinks.Add Anchor:=Ziel.Cells(lngRow, 3), Address:=URL, TextToDisplay:=Display
'******************** - Blattschutz - *******************
If Blattschutz = True Then
Quelle.Protect Password:="CRP"
End If
Else
'MsgBox "No datas avaiable" & Chr(10) & Fileitem.Path
End If
'Worksheet CRP_Aktionen Cin
Dim Zeile, s, t, CRP_Master_letzte_Zeile, CRP_Anzahl_Aktionen As Integer
Set Quelle_Aktionen = ActiveWorkbook.Worksheets("Aktionen")
Set Ziel_Aktionen = ThisWorkbook.Worksheets("CRP_Aktionen")
'Ermittlung letzte Zeile Splate A Tabelle Crp Aktionen
If Quelle_Aktionen.Name = "Aktionen" Then
If Ziel_Aktionen.Cells(9, 1) = "" Then
CRP_Master_letzte_Zeile = 9
Ziel_Aktionen.Cells(9, 1) = 1
Else
CRP_Master_letzte_Zeile = EFZVUIS(Ziel_Aktionen, 1) - 1
End If
'MsgBox Quelle_Aktionen.Name
CRP_Anzahl_Aktionen = EFZVUIS(Quelle_Aktionen, 1) - 12
Zeile = CRP_Master_letzte_Zeile + CRP_Anzahl_Aktionen
If CRP_Anzahl_Aktionen > 0 Then
For k = CRP_Master_letzte_Zeile To Zeile
'Biodaten werden übetragen
Ziel_Aktionen.Cells(k, 1) = k - 8 'No.
Ziel_Aktionen.Cells(k, 2) = Quelle.Cells(5, 3) 'Title
Ziel_Aktionen.Cells(k, 3) = Quelle.Cells(1, 6) 'Doc. No.
Ziel_Aktionen.Cells(k, 4) = Quelle.Cells(2, 6) 'Issue
Ziel_Aktionen.Cells(k, 5) = Fileitem.Name 'FileItem.Name
Ziel_Aktionen.Cells(k, 6) = Quelle.Cells(3, 6) 'Originator
Ziel_Aktionen.Cells(k, 7) = Quelle.Cells(3, 7) 'Organization
Ziel_Aktionen.Cells(k, 8) = Quelle.Cells(4, 6) 'Date
Ziel_Aktionen.Cells(k, 9) = Quelle.Cells(6, 3) 'Customer
Ziel_Aktionen.Cells(k, 10) = Quelle.Cells(6, 6) 'Project
Ziel_Aktionen.Cells(k, 11) = Quelle.Cells(7, 3) 'Name LRU
Ziel_Aktionen.Cells(k, 12) = Quelle.Cells(8, 3) 'Part Number
Ziel_Aktionen.Cells(k, 13) = Quelle.Cells(9, 3) 'Article Number
Ziel_Aktionen.Cells(k, 14) = Quelle.Cells(7, 6) 'Name Piece Part
Ziel_Aktionen.Cells(k, 15) = Quelle.Cells(8, 6) 'Part Number
Ziel_Aktionen.Cells(k, 16) = Quelle.Cells(9, 6) 'Article Number
Display = Ziel_Aktionen.Cells(k, 3).Value
URL = Fileitem.Path
Ziel.Hyperlinks.Add Anchor:=Ziel_Aktionen.Cells(k, 3), Address:=URL, TextToDisplay:= _
_
Display
Next
t = EFZVUIS(Quelle_Aktionen, 1) - 1
For s = 11 To t
'Aktionen Daten Cin
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 17) = Quelle_Aktionen.Cells(s, 1) ' _
Subject
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 18) = Quelle_Aktionen.Cells(s, 2) ' _
Reference
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 19) = Quelle_Aktionen.Cells(s, 3) 'M/ _
_
A
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 20) = Quelle_Aktionen.Cells(s, 4) 'Nr. _
_
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 21) = Quelle_Aktionen.Cells(s, 5) ' _
Measure / Resulting Action
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 22) = Quelle_Aktionen.Cells(s, 6) ' _
Target
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 23) = Quelle_Aktionen.Cells(s, 7) ' _
Status / Measure of Success
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 24) = Quelle_Aktionen.Cells(s, 8) ' _
Responsible
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 25) = Quelle_Aktionen.Cells(s, 9) ' _
Department
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 26) = Quelle_Aktionen.Cells(s, 10) ' _
_
Company
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 27) = Quelle_Aktionen.Cells(s, 11) ' _
_
Issued
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 28) = Quelle_Aktionen.Cells(s, 12) ' _
_
Target
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 29) = Quelle_Aktionen.Cells(s, 13) ' _
_
Complete
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 30) = Quelle_Aktionen.Cells(s, 14) ' _
_
Priority
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 31) = Quelle_Aktionen.Cells(s, 15) ' _
_
Remarks
'Status der Aktion auslesen / gelb / rot
If Quelle_Aktionen.Cells(s, 1).Interior.ColorIndex = 4 Then ' grün
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 17).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 18).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 19).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 20).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 21).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 22).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 23).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 24).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 25).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 26).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 27).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 28).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 29).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 30).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 31).Inerior.ColorIndex = 4
End If
If Quelle_Aktionen.Cells(s, 1).Interior.ColorIndex = 6 Then ' gelb
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 17).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 18).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 19).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 20).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 21).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 22).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 23).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 24).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 25).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 26).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 27).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 28).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 29).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 30).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 31).Inerior.ColorIndex = 6
End If
If Quelle_Aktionen.Cells(s, 1).Interior.ColorIndex = 3 Then ' rot
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 17).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 18).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 19).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 20).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 21).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 22).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 23).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 24).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 25).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 26).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 27).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 28).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 29).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 30).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 31).Inerior.ColorIndex = 3
End If
CRP_Master_letzte_Zeile = CRP_Master_letzte_Zeile + 1
Next
'Quelle_Aktionen = True END iF
End If
lngRow = lngRow + 1
'ActiveWorkbook.Close SaveChanges:=False
'if_3
End If
ActiveWorkbook.Close SaveChanges:=False
'if_2
End If
'if_1
End If
'For 1) Next
Next Fileitem
If IncludeSubfolders = True Then ' Rekursiv
For Each SubFolder In Sourcefolder.SubFolders
Call ListFilesInFolder(SubFolder.Path, Verknuepfung)
Next SubFolder
End If
Set Fileitem = Nothing
Set Sourcefolder = Nothing
Set fso = Nothing
ActiveWorkbook.Saved = True
End Sub