AW: Daten aus anderer Excel-Datei importieren
01.10.2017 14:00:56
Peter(silie)
Hallo,
erstmal die Frage: Sollen die Daten aus allen 75 in eine oder sollen 75 neue Dateien enstehen...
Solltest du 75 neue Dateien erstellen wollen, sehe ich keinen Sinn in der ganzen Sache.
Wenn du eine Master Datei hast, wo die Daten hintereinander rein kopiert werden sollen, macht es wieder Sinn.
Wenn du nur die Daten von A:AK nach D:AN verschieben willst, ist das auch wieder was ganz anderes.
Hier mal ein Code, der sich alle xls und xlsx Dateien aus einem angegebenen Ordner holt und die daten aus A:AK nach D:AN kopiert, in das Workbook wo das Makro steht.
Option Explicit
Private MasterSheet As Worksheet
Public Sub ImportNewData()
Dim FileArray, varItem As Variant
Dim range_, tmpRange As Range
Dim Path_ As String
Dim ws As Worksheet
Dim wb As Workbook
Path_ = "Dein Ordnerpfad mit Dateien"
FileArray = FilesOfFolder(Path_)
Set MasterSheet = ThisWorkbook.Sheets(1)
Set range_ = MasterSheet.Range("D6:AN2500")
For Each varItem In FileArray
Set wb = Workbooks.Open(varItem)
Set ws = wb.Sheets(1)
Set tmpRange = ws.Range("A2:AK2500")
tmpRange.Copy range_
Application.CutCopyMode = False
Next varItem
End Sub
Private Function FilesOfFolder(ByVal Path_ As String) As Variant
Dim folder_, file_, fso As Object
Dim array_() As Variant
Dim Type_ As String
Dim counter As Long
If Dir(Path_, vbDirectory) = vbNullString Then Exit Function
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder_ = fso.GetFolder(Path_)
For Each file_ In folder_.Files
Type_ = GetFileType(file_.Name)
If FileIsValid(Type_) Then
ReDim Preserve array_(counter)
array_(counter) = file_.Path
counter = counter + 1
End If
Next file_
FilesOfFolder = array_
Set fso = Nothing
Set file_ = Nothing
Set folder_ = Nothing
End Function
Private Function GetFileType(ByVal FilePath As String)
GetFileType = Right(FilePath, Len(FilePath) - InStrRev(FilePath, "."))
End Function
Private Function FileIsValid(ByVal Type_ As String) As Boolean
Select Case Type_
Case "xlsx", "xls": FileIsValid = True
Case Else: FileIsValid = False
End Select
End Function