Ein Tabellenblatt in 300 Excel Dateien

Hallo,
ich brauche mal euer Hilfe.
Ich habe in einem Ordner Stunden eine Formulardatei "Stundenblatt .xlsm" In dem ein neues Tabellenblatt mit dem Namen "Prüfen" erstellt habe. Dieses beinhaltet Formeln Makros u. Berechnungen.
Der Ordner Stunden beinhaltet über 250 Dateien, die alle Verschiedene Namen haben.
Dieses Tabellenblatt "Prüfen" soll nun in alle Dateien.
Hierfür bräuchte ich ein Makro was dieses Tabellenblatt "Prüfen" automatisch in alle anderen Dateien in diesem Ordner kopiert.
Ich habe im Netz nach geschaut und diese Makro gefunden, was wahrscheinlich dieses erfüllt. Habe es getestet aber leider bleibt es
an folgender Position stehen
With Application.FileSearch
Hier noch das ganze Makro

Public Sub Blatt_kopieren()
Dim WS_kopie As Worksheet
Dim i As Integer
Dim WB As Workbook
Set WS_kopie = ThisWorkbook.Sheets("Prüfen")
With Application.FileSearch
.NewSearch
.LookIn = "G:\Stunden"      '  0 Then
For i = 1 To .FoundFiles.count
If .FoundFiles(i)  ThisWorkbook.FullName Then
Set WB = Workbooks.Open(Filename:=.FoundFiles(i))
WS_kopie.Copy after:=WB.Sheets(WB.Sheets.count)
WB.ChangeLink Name:=ThisWorkbook.Name, NewName:=WB.Name, Type:=xlExcelLinks
WB.Close savechanges:=True
End If
Next i
Else
MsgBox "Es wurden keine Exceldateien gefunden.", vbCritical, "Achtung"
End If
End With
End Sub

Ich kenne mich damit überhaupt nicht aus und bin auf eure Hilfe angewiesen. Wär super wenn ihr mich unterstützen könntet.
Danke im Voraus.
speednetz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Public Sub Blatt_kopieren() Const FOLDER_PATH As String = "G:\Stunden\" Dim WS_kopie As Worksheet Dim WB As Workbook Dim strFilename As String With Application .Calculation = xlCalculationManual .EnableEvents = False .ScreenUpdating = False End With Set WS_kopie = ThisWorkbook.Worksheets("Prüfen") strFilename = Dir$(FOLDER_PATH & "*.xlsm") Do Until strFilename = vbNullString If strFilename ThisWorkbook.Name Then Set WB = Workbooks.Open(Filename:=FOLDER_PATH & strFilename) WS_kopie.Copy After:=WB.Sheets(WB.Sheets.Count) WB.ChangeLink Name:=ThisWorkbook.Name, _ NewName:=WB.Name, Type:=xlExcelLinks WB.Close SaveChanges:=True Set WB = Nothing End If strFilename = Dir$ Loop Set WS_kopie = Nothing With Application .Calculation = xlCalculationAutomatic .EnableEvents = True .ScreenUpdating = True End With End Sub

Option Explicit Public Sub Code_kopieren() Const FOLDER_PATH As String = "G:\Stunden\" Dim strCode As String Dim WB As Workbook Dim strFilename As String With Application .Calculation = xlCalculationManual .EnableEvents = False .ScreenUpdating = False End With With ThisWorkbook.VBProject.VBComponents("Tabelle3").CodeModule strCode = .Lines(StartLine:=1, Count:=.CountOfLines) End With strFilename = Dir$(FOLDER_PATH & "*.xlsm") Do Until strFilename = vbNullString If strFilename ThisWorkbook.Name Then Set WB = Workbooks.Open(Filename:=FOLDER_PATH & strFilename) With WB.VBProject.VBComponents("Tabelle3").CodeModule Call .DeleteLines(StartLine:=1, Count:=.CountOfLines) Call .InsertLines(Line:=1, String:=strCode) End With WB.Close SaveChanges:=True Set WB = Nothing End If strFilename = Dir$ Loop With Application .Calculation = xlCalculationAutomatic .EnableEvents = True .ScreenUpdating = True End With End Sub

Beliebteste Forumthreads (12 Monate)

Ein Tabellenblatt in 300 Excel Dateien

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread