Thema: Makro, dass Daten aus Excel in eine Datei überträg

Guten Abend :)
Und zwar hätte ich gerne ein Makro in Excel, dass mir bei Klick auf den Button die Excellisten in einem bestimmten Ordner zusammenfügt, also immer in der aktuellen Hauptexceldatei, in der das Makro sein soll, die Daten unten anfügt.
Kann mir jemand helfen?
Vielen Dank

niemand?=(

Hallo Braun?
Einen Vornamen anzugeben hilft meistens. Auserdem wären mehr Infos hilfreich. Welche Daten,warum diese Daten, wohin sollen die Daten? Eine Beispieldatei könnte auch helfen.
Glaskugeln zum Hellsehen haben die Wenigsten hier im Forum.
Gruß
Andre

Hallo Braun,
bitte etwas Geduld mitbringen, wir sind keine Angestellten hier ;)
Standard-Verzeichnis bitte anpassen.

Option Explicit
' öffentliche Variablen
Dim myFileAddress As Variant, myFileDirectory As String, myFile As String
Dim wksZiel As Worksheet
Dim wbZiel As Workbook
Sub Dateiimport()
Dim Zähler As Long
' -- Bezüge --
Const StandardVerzeichnis = "R:\Arbeitsordner\04 AGW\2015-08-11 Lagerdurchmesser OP60"
Set wksZiel = Tabelle1
Set wbZiel = ThisWorkbook
Application.ScreenUpdating = False
Application.Calculation = xlManual
' Hinweis
MsgBox "Dieses Tool lädt sämtliche Excel-Tabellen im ausgwählten Ordner in das Dokument. " & _
"Dateien die nicht erfasst werden sollen, sind vorher in ein anderes Verzeichnis " & _
"zu verschieben. Der Vorgang kann je nach Anzahl mitunter einige Minuten in " & _
"Anspruch nehmen.", , "Hinweis"
' Standard-Verzeichnis wechseln
ChDrive Left(StandardVerzeichnis, 1)
ChDir StandardVerzeichnis
myFileAddress = Application.GetOpenFilename("Excel-Dateien *.xls*,*.xls*")
If myFileAddress = False Then GoTo Endmarke ' Wenn 'Abbrechen' gewählt, ...
myFileDirectory = CurDir(myFileAddress)
myFile = Dir("*.xls*")
Do Until myFile = ""
Open_File   ' Datei öffnen und Inhalt kopieren
Zähler = Zähler + 1
Application.StatusBar = "Datei #" & Zähler & "  """ & myFile & """ importiert"
myFile = Dir ' nächste Datei
Loop
' Kopf-/Fußzeilen löschen, Formatierung …
Application.StatusBar = "Bereit"
MsgBox Zähler & " Dateien importiert.", vbInformation, "Vorgang abgeschlossen"
Endmarke: ' Grundeinstellungen
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub
Private Sub Open_File()
Dim wbQuelle As Workbook
Dim wks As Worksheet
' Quelldatei öffnen, nur Lesezugriff
Set wbQuelle = Workbooks.Open(Filename:=myFileDirectory & "\" & myFile, ReadOnly:=True)
' Inhalt jedes TB kopieren und in Zieldatei einfügen
For Each wks In wbQuelle.Worksheets
wks.Select
wks.Range("A1:" & wks.Range("A1").SpecialCells(xlCellTypeLastCell).Address).Copy
wbZiel.Activate
With wksZiel
If .Range("A1") <> "" Then
.Range("A" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Select
Else: .Range("A1").Select
End If
.Paste
End With
wbQuelle.Activate
Next wks
' Quelldatei schließen
wbQuelle.Close savechanges:=False
wbZiel.Activate
wksZiel.Range("A1").Select
End Sub

lg Matthias

Guten Abend :)
Und zwar hätte ich gerne ein Makro in Excel, dass mir bei Klick auf den Button die Excellisten in einem bestimmten Ordner zusammenfügt, also immer in der aktuellen Hauptexceldatei, in der das Makro sein soll, die Daten unten anfügt.
Kann mir jemand helfen?
Vielen Dank

niemand?=(

Hallo Braun?
Einen Vornamen anzugeben hilft meistens. Auserdem wären mehr Infos hilfreich. Welche Daten,warum diese Daten, wohin sollen die Daten? Eine Beispieldatei könnte auch helfen.
Glaskugeln zum Hellsehen haben die Wenigsten hier im Forum.
Gruß
Andre

Hallo Braun,
bitte etwas Geduld mitbringen, wir sind keine Angestellten hier ;)
Standard-Verzeichnis bitte anpassen.

Option Explicit
' öffentliche Variablen
Dim myFileAddress As Variant, myFileDirectory As String, myFile As String
Dim wksZiel As Worksheet
Dim wbZiel As Workbook
Sub Dateiimport()
Dim Zähler As Long
' -- Bezüge --
Const StandardVerzeichnis = "R:\Arbeitsordner\04 AGW\2015-08-11 Lagerdurchmesser OP60"
Set wksZiel = Tabelle1
Set wbZiel = ThisWorkbook
Application.ScreenUpdating = False
Application.Calculation = xlManual
' Hinweis
MsgBox "Dieses Tool lädt sämtliche Excel-Tabellen im ausgwählten Ordner in das Dokument. " & _
"Dateien die nicht erfasst werden sollen, sind vorher in ein anderes Verzeichnis " & _
"zu verschieben. Der Vorgang kann je nach Anzahl mitunter einige Minuten in " & _
"Anspruch nehmen.", , "Hinweis"
' Standard-Verzeichnis wechseln
ChDrive Left(StandardVerzeichnis, 1)
ChDir StandardVerzeichnis
myFileAddress = Application.GetOpenFilename("Excel-Dateien *.xls*,*.xls*")
If myFileAddress = False Then GoTo Endmarke ' Wenn 'Abbrechen' gewählt, ...
myFileDirectory = CurDir(myFileAddress)
myFile = Dir("*.xls*")
Do Until myFile = ""
Open_File   ' Datei öffnen und Inhalt kopieren
Zähler = Zähler + 1
Application.StatusBar = "Datei #" & Zähler & "  """ & myFile & """ importiert"
myFile = Dir ' nächste Datei
Loop
' Kopf-/Fußzeilen löschen, Formatierung …
Application.StatusBar = "Bereit"
MsgBox Zähler & " Dateien importiert.", vbInformation, "Vorgang abgeschlossen"
Endmarke: ' Grundeinstellungen
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub
Private Sub Open_File()
Dim wbQuelle As Workbook
Dim wks As Worksheet
' Quelldatei öffnen, nur Lesezugriff
Set wbQuelle = Workbooks.Open(Filename:=myFileDirectory & "\" & myFile, ReadOnly:=True)
' Inhalt jedes TB kopieren und in Zieldatei einfügen
For Each wks In wbQuelle.Worksheets
wks.Select
wks.Range("A1:" & wks.Range("A1").SpecialCells(xlCellTypeLastCell).Address).Copy
wbZiel.Activate
With wksZiel
If .Range("A1") <> "" Then
.Range("A" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Select
Else: .Range("A1").Select
End If
.Paste
End With
wbQuelle.Activate
Next wks
' Quelldatei schließen
wbQuelle.Close savechanges:=False
wbZiel.Activate
wksZiel.Range("A1").Select
End Sub

lg Matthias