Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1700to1704
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Reiter aus File kopieren

Reiter aus File kopieren
01.07.2019 10:49:36
Patrick
Hallo liebe Herber Community,
ich habe eine, für euch sicherlich kleine, Challenge.
Ich habe in einem bestimmten Ordner Files liegen. In jedem dieser Files befindet sich ein Reiter Namens "Übersicht". Ich möchte nun diese "Übersicht"-Reiter aus den einzelnen Sheets in ein neues Excel File kopieren. Im neuen Excel File sollen diese Reiter dann nach den Filenamen benannt werden. Ich schicke euch anbei meinen Code-Versuch, der aber leider nicht funktioniert hat bis jetzt..
Ich hoffe ihr könnt mir hier helfen. Danke schonmal und LG Patrick

Sub Import()
' Import Makro
Dim wb As Workbook
Dim strmyPath As String
Dim strmyDat As String
strmyPath = "Pfad\"
Pfadlänge = Len(strmyPath)
strmyDat = Dir(strmyPath & "*.xls")
Do While strmyDat  ""
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Set wb = Workbooks.Open(strmyPath & strmyDat)
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
Textlänge = wb.FullName
Worksheets("Übersicht").Select
Textlänge = Len(Full_filename) - Len(Pfadlänge)
Name = Mid(Textlänge, Pfadlänge + 1, Textlänge - 4)
Sheets("Übersicht").Copy Before:=Workbooks("20190701 Konsolidierung.xlsm"). _
Sheets(1)
Workbooks("20190701 Konsolidierung.xlsm").Activate
Sheets("Übersicht").Select
ActiveSheet.Name = Name
wb.Close False
strmyDat = Dir
Loop
End Sub


3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Reiter aus File kopieren
01.07.2019 11:27:52
Rudi
Hallo,
versuch das mal:
Sub Import()
' Import Makro
Dim wb As Workbook
Dim strmyPath As String
Dim strmyDat As String
Dim strName As String
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
strmyPath = "Pfad\"
strmyDat = Dir(strmyPath & "*.xls")
Do While strmyDat  ""
Set wb = Workbooks.Open(strmyPath & strmyDat)
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
strName = Left(strmyDat, InStrRev(strmyDat, ".") - 1)
wb.Sheets("Übersicht").Copy Before:=ThisWorkbook.Sheets(1)
ActiveSheet.Name = strName
wb.Close False
strmyDat = Dir
Loop
End Sub

Der Code gehört in das WB in das die Blätter kopiert werden.
Gruß
Rudi
Anzeige
AW: Reiter aus File kopieren
02.07.2019 14:15:14
Patrick
Hallo Rudi,
funktioniert super. Danke!!
LG
Patrick
AW: Reiter aus File kopieren
02.07.2019 14:15:15
Patrick
Hallo Rudi,
funktioniert super. Danke!!
LG
Patrick

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige