Supportnet / Forum / Tabellenkalkulation
Sheets aus verschiedenen Excel-Dateien importieren
Frage
Hallo!
Ich möchte aus verschiedenen Excel-Dateien das jeweils erste Sheet in [i] eine[/i] feste, geöffnete Excel-Datei kopieren.
Aus welchen Dateien importiert werden soll, soll bei Click auf einen Button (der sich in dem ersten Sheet der Datei, in die importiert wird befindet) über einen "Dateiauswahl"-Dialog geschehen.
Die zu importierenden Dateien stehen alle in einem Ordner. Toll wäre es, wenn die Formatierung der importierten Sheets erhalten bliebe.
Danke schonmal für evtl. Vorschläge!:)
Grüße,
Fino
Antwort 1 von piano
hallo
Hier ein Makro dazu:
Beim Öffnen der Mappe wird eine Liste aller Dateien des Verzeichnisses in der letzten Spalte gebildet. Diese wird für die Gültigkeitsprüfung in Zelle A5
verwendet. Bei Wahl einer Mappe wird die 1.Tabelle hinter die letzte Tabelle der Master-Mappe mit Name Importx kopiert.
In VBA-Umgebung Diese Arbaitsmappe doppelklicken und hier den Code eingeben( Konstanten richtigstellen) .
Alle unnötigen Tabellen löschen und Speichern.
Gruß piano
Es wäre nett, wenn Du ein Feedback abgeben könntest,
ob der Lösungsvorschlag Dein Problem gelöst hat.
Hier ein Makro dazu:
Const MappenName = "ImportMehrereMappen.xls"
Const Verz = "C:Eigene Dateien"
Const AuswahlRange = "$A$5"
Private Sub Workbook_Open()
x = DateienAuflisten()
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim MName, i, Anz
If ActiveWorkbook.Name = MappenName Then
If ActiveSheet.Name = Sheets(1).Name Then
If ActiveCell.Address = AuswahlRange Then
Anz = ActiveWorkbook.Sheets.Count
MName = ActiveCell.Value
´ActiveCell.Offset(1, 0).Activate
´ActiveCell.Select
ChDir Verz
On Error Resume Next
Workbooks.Open MName
Workbooks(MName).Activate
ActiveWorkbook.Sheets(1).Select
ActiveWorkbook.Sheets(1).Copy After:=Workbooks("ImportMehrereMappen.xls").Sheets(Anz)
ActiveWorkbook.Sheets(Anz + 1).Name = "Import" & Anz
Workbooks(MappenName).Activate
ActiveWorkbook.Sheets(1).Select
Workbooks(MName).Close
End If
End If
End If
End Sub
Function DateienAuflisten()
Dim i As Long, DName
´Dim Dateien As String
´Const Verz = "C:Eigene Dateien"
On Error GoTo fehler
ChDir Verz
Sheets(1).Activate
Range("IV1").Select
With Application.FileSearch
.NewSearch
.LookIn = Verz
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
.Execute
For i = 1 To .FoundFiles.Count
´Dateien = Dateien & .FoundFiles(i) & ";"
DName = .FoundFiles(i)
z = InStr(1, DName, ":")
If z <> 0 Then
DName = Right(DName, (Len(DName) - z)) ´Laufwerk eliminieren
End If
Do While InStr(1, DName, "") <> 0
z = InStr(1, DName, "")
DName = Right(DName, (Len(DName) - z)) ´Pfad eliminieren
Loop
´ActiveCell.Value = DName
´ActiveCell.Offset(1, 0).Select
Next i
End With
Range("a5").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$IV$1:$IV$" & i
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = "Excel-Dateien in Verzeichnis"
.ErrorTitle = ""
.InputMessage = "Wählen Sie eine Mappe aus"
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
GoTo exex:
fehler:
MsgBox "Es gibt kein Verzeichnis mit dem Namen " & Verz
exex:
End Function
Beim Öffnen der Mappe wird eine Liste aller Dateien des Verzeichnisses in der letzten Spalte gebildet. Diese wird für die Gültigkeitsprüfung in Zelle A5
verwendet. Bei Wahl einer Mappe wird die 1.Tabelle hinter die letzte Tabelle der Master-Mappe mit Name Importx kopiert.
In VBA-Umgebung Diese Arbaitsmappe doppelklicken und hier den Code eingeben( Konstanten richtigstellen) .
Alle unnötigen Tabellen löschen und Speichern.
Gruß piano
Es wäre nett, wenn Du ein Feedback abgeben könntest,
ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 2 von Fino
Was ein Formelwust*g*...ich bin beeindruckt!
Ich bekomme aber leider immer die Fehlermeldung: "Es gibt kein Verzeichnis mit dem Namen " & Verz"...
Grüße,
Fino
Ich bekomme aber leider immer die Fehlermeldung: "Es gibt kein Verzeichnis mit dem Namen " & Verz"...
Grüße,
Fino
Antwort 3 von piano
Hallo
halb so schlimm.
Wie lautet der Pfad und wie hast Du die Konstanten angepasst?
Ev. sende mir Deine Mappe an piano1244@hotmail.com
halb so schlimm.
Wie lautet der Pfad und wie hast Du die Konstanten angepasst?
Ev. sende mir Deine Mappe an piano1244@hotmail.com
Antwort 4 von piano
Hallo
Aus irgendwelchen Gründen sind einige Zeilen aus der For-Schleife verstümmelt angekommen:
Do While InStr(1, DName, "") <> 0
z = InStr(1, DName, "")
DName = Right(DName, (Len(DName) - z)) ´Pfad eliminieren
Loop
ActiveCell.Value = DName
ActiveCell.Offset(1, 0).Select
ausserdem sind die Kommentarzeilen (´) mit dem einfachen Hochkomma zu versehen (Fehler von Supportnet).
Gruss piano
Aus irgendwelchen Gründen sind einige Zeilen aus der For-Schleife verstümmelt angekommen:
Do While InStr(1, DName, "") <> 0
z = InStr(1, DName, "")
DName = Right(DName, (Len(DName) - z)) ´Pfad eliminieren
Loop
ActiveCell.Value = DName
ActiveCell.Offset(1, 0).Select
ausserdem sind die Kommentarzeilen (´) mit dem einfachen Hochkomma zu versehen (Fehler von Supportnet).
Gruss piano
Antwort 5 von piano
Hallo
wie ich soeben bemerke , hat es wieder einen Übertragungsfehler gegeben:
2 mal DName, ""
Zwischen die beiden Apostrophe gehört ein " Backslash" - dieser wird offensichtlich auch von Supportnet eliminiert !!!
wie ich soeben bemerke , hat es wieder einen Übertragungsfehler gegeben:
2 mal DName, ""
Zwischen die beiden Apostrophe gehört ein " Backslash" - dieser wird offensichtlich auch von Supportnet eliminiert !!!