Hola mo.choice,
habe eine Lösung gefunden, bin aber selbst noch blutiger Anfänger und deshalb wird es bestimmt einfachere und bessere Lösungen geben, aber es funktioniert. Zur Erklärung:
Wie gesagt, etwas umständlich aber bis jetzt habe ich es nicht besser hinbekommen.
Modul 1:
Option Explicit
Sub Daten_sammeln_Einzeln_Seperat()
Dim WKS As Worksheet, lastRow1 As Long, lastRow2 As Long, lastRow3 As Long
With Sheets(„Tabelle1“) 'Blatt in dem die Daten gesammelt werden.(Name anpassen)
lastRow1 = 3 ’ oder 2 wenn die Eintrageung in Zeile zwei beginnen soll
lastRow2 = 4
lastRow3 = 5
.Range(„B3:C5“).ClearContents
For Each WKS In ThisWorkbook.Worksheets
If WKS.Name .Name And WKS.Index >= 4 Then
.Cells(lastRow1, 2) = WKS.Range(„AE19“)
.Cells(lastRow1, 3) = WKS.Range(„AF19“)
.Cells(lastRow2, 2) = WKS.Range(„AE31“)
.Cells(lastRow2, 3) = WKS.Range(„AF31“)
.Cells(lastRow3, 2) = WKS.Range(„AE35“)
.Cells(lastRow3, 3) = WKS.Range(„AF35“)
End If
Next WKS
End With
ActiveSheet.Shapes.Range(Array(„Button 1“)).Select
Selection.Delete
Call Export_mit_Dialog
_End Sub
Modul2:
Sub Export_mit_Dialog()_
Dim Quelle As Object, Ziel As Object
Dim Datei As String
On Error GoTo Fehler
'Dialog „Datei öffnen“ anzeigen
Datei = Application.GetOpenFilename(„Excel-Dateien(*.xlsm),*xlsm“)
'Abbrechen falls keine Datei ausgewählt
If Datei = „Falsch“ Then
MsgBox „keine Datei ausgewählt“, , „Abbruch“
Exit Sub
End If
'MsgBox "Ausgewählte Datei: " & Datei, , „“
'Ausgewählte Datei öffnen
Workbooks.Open Filename:=Datei
Set Quelle = ThisWorkbook.Worksheets(1)
Set Ziel = ActiveWorkbook.Worksheets(1)
'kopieren und einfügen
Quelle.UsedRange.Copy Ziel.Cells(3, 2)
ActiveWorkbook.Close
'Speicher freigeben
Set Quelle = Nothing
Set Ziel = Nothing
Exit Sub
Fehler:
Set Quelle = Nothing
Set Ziel = Nothing
MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
& "Beschreibung: " & Err.Description _
, vbCritical, „Fehler“
End Sub
Ich sammle erst die Daten aus Tabelle4 in Tabelle1 und kopiere sie dann ohne Schaltfläche in den ausgewählten Ordner. Wichtig ist nur das du die Ordner unter Excel Arbeitsmappe mit Makros speicherst. Und an alle Experten, fallt nicht über mich her, wie gesagt, ich fange gerade erst an und habe auf meine Weise an meinem Rechner das Problem gelöst bekommen. Ich hoffe ich habe alles richtig verstanden und du kannst es gebrauchen. Freue mich aber wenn einer schreib wie es richtig und einfacher ist.
Saludos de Carsten
