Kopieren von einer Tabelle in eine Andere

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub a() Dim wbQuelle As Workbook 'anpassen Const wbPfad As String = "\DeinPfad\DeineDatei.xlsx" Const wsName As String = "Tabelle1" Application.ScreenUpdating = False With ThisWorkbook Set wbQuelle = Workbooks.Open(Filename:=wbPfad) ActiveWorkbook.Sheets(wsName).Copy After:=.Sheets(.Sheets.Count) wbQuelle.Close savechanges:=True .Sheets(.Sheets.Count).Activate .Sheets(.Sheets.Count).Name = Date End With Application.ScreenUpdating = True End Sub

Sub OP_Listen_Import() On Error GoTo Fehler Dim Vorgabe As String ' Vorgabe für den Dateinamen zur Dateiauswahl Dim Pfad As String ' Vorgabe für den Pfad zur Dateiauswahl Dim Dialog As FileDialog Dim strDateiName1 As String Application.ScreenUpdating = False Vorgabe = "Liste" ' Nur Dateien mit einem bestimmten Muster werden gelistet Pfad = Environ("UserProfile") & "\Desktop\" ' Desktop als Anfangsverzeichnis Set Dialog = Application.FileDialog(msoFileDialogFilePicker) ' Dialog zur Dateiauswahl With Dialog .AllowMultiSelect = False .InitialFileName = Pfad & "*" & Vorgabe & "*" .InitialView = msoFileDialogViewDetails .Title = "Datei auswählen" End With ActiveWorkbook.Worksheets.Add after:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets. _ Count) ' Neues Blatt mit aktuellem Datum einfügen ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count).Name = VBA.Date strDateiName1 = ActiveWorkbook.Name If Dialog.Show = True Then Workbooks.Open Filename:=Dialog.SelectedItems(1) ' Dialog öffen um die zu _ bearbeitende Datei auszuwählen ' >> hier den Importskript für den Import der gefilterten OP-Datei auf das neu erstellte _ Arbeitsblatt End If Err.Clear Fehler: If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear End Sub

Sub b() Dim DateiDialog As FileDialog Dim wbPfad As String Dim wbQuelle As Workbook Const wsName As String = "Tabelle1" Dim objDateiSystem As Object Dim objDatei As Object 'Bildschirm-Aktualisierung ausschalten Application.ScreenUpdating = False Set objDateiSystem = CreateObject("Scripting.FileSystemObject") Set DateiDialog = Application.FileDialog(msoFileDialogFilePicker) 'Dateiauswahl über Dialog... With DateiDialog .Title = "Bitte Quell-Arbeitsmappe wählen" .AllowMultiSelect = False If .Show -1 Then MsgBox "Vorgang abgebrochen", vbInformation Exit Sub Else: wbPfad = .SelectedItems(1) End If End With '...mit dem entsprechenden Datei-Pfad With ThisWorkbook '...die Quell-Datei öffnen Set wbQuelle = Workbooks.Open(Filename:=wbPfad) '...Zugriff auf Datei über Datei-System für Erstelldatum Set objDatei = objDateiSystem.getfile(wbQuelle.FullName) '...das gewünschte Blatt in _diese_ Datei kopieren '--> gesuchter Blattname im Quell-Blatt als Konstante definiert (s.o.) ActiveWorkbook.Sheets(wsName).Copy after:=.Sheets(.Sheets.Count) '...dem kopierten Blatt das Erstelldatum der Quell-Datei als Name übergeben .Sheets(.Sheets.Count).Name = Left(objDatei.DateCreated, 10) '...Quell-Datei schließen, Änderungen speichern wbQuelle.Close savechanges:=True End With 'Bildschirm-Aktualisierung einschalten Application.ScreenUpdating = True End Sub

Hallo Michael,
danke vorab für deine Hilfe. Du hast recht, genau so gehe ich vor. Wenn ich einen Code bekomme, versuche ich für mich zu interpretieren was genau an welcher Stelle gemacht wird. Die Kommentare im Code helfen dabei natürlich ungemein (macht aber glücklicherweise fast jeder hier :) ) Aber ich muss auch sagen, dass es ja immer 100 Wege gibt ein Problem/Fragestellung zu lösen. Und diese Tatsache macht es nicht einfacher. Jeder geht wieder etwas anders an die Lösung ran.
Zu deinem Code:
Es funktioniert soweit alles wie ich mir das vorgestellt habe. Danke auch für das Einbauen des Erstelldatums als Tabellenname. Ich habe da schon mehrere Varianten probiert, aber so richtig funktioniert hat nichts.
Warum verwendest du eine Konstante für den Tabellennamen der Importdatei? ich kann doch hier sicher auch eine variable nutzen, da der Tabellenname der Ursprungsdatei von einem Kollegen händisch gepflegt wird. Ich verlasse mich nicht drauf, dass der immer gleich ist :)

    Const wsName As String = "Tabelle1"

LG
Christian

Morgen Christian!
dass es ja immer 100 Wege gibt ein Problem/Fragestellung zu lösen. Und diese Tatsache macht es nicht einfacher. Jeder geht wieder etwas anders an die Lösung ran.
Da hast Du Recht; und nix für ungut - ich wollte Dich nicht belehren, war nur gestern mein Eindruck.
Es funktioniert soweit alles wie ich mir das vorgestellt habe.
Das freut mich.
Warum verwendest du eine Konstante für den Tabellennamen der Importdatei? ich kann doch hier sicher auch eine variable nutzen
Ja, eine Variable ist auch möglich; die Frage ist hier aber, ob Dir die mehr hilft. Ich hab jetzt mal auf eine Konstante gesetzt, weil dadurch der Code etwas bequemer anzupassen ist, und es wird sofort im Prozedurkopf klar, dass im folgenden Code immer auf einen bestimmten Blattnamen zugegriffen wird. Wenn bspw. das Quell-Tabellenblatt bisher immer "Tabelle1" hieß, aber dann einigt Ihr Euch auf "Quelle" - so musst Du im Code nicht lange suche, sondern änderst nur den Wert der Konstanten und fertig.
Genauso könnten wir ja auch sagen, wir verwenden keine Konstante für den Blatt-Namen sondern für die Blatt-Indexnummer. Da wär's zB egal, wie das Blatt heißt, wenn nur seine Position in der Mappe immer gleich bleibt; also sinngemäß


Const wsNummer as Byte = 1
ActiveWorkbook.Sheets(wsNummer).Copy after:=.Sheets(.Sheets.Count)

Du sagst aber richtigerweise
Ich verlasse mich nicht drauf, dass der immer gleich ist :)
Sowohl Blatt-Name als auch Position (also Index-Nummer) können sich schnell ändern; ob das auch auf die Blattposition zutrifft musst Du bei Deinen Gegebenheiten (und Kollegen) beurteilen. Aber es bleibt Dir noch die Alternative den Codenamen des gewünschten Tabellenblattes in der Quell-Datei zu nutzen - also den Objekt-Namen des Tabellenblattes in VBA zu ändern:
Userbild

Dann ist sowohl die Position des Blattes als auch der angezeigte Blattname egal, und Du beziehst Dich im Code auf den Codenamen; den Codenamen zu nutzen geht aber nur innerhalb einer Mappe ohne Umwege, bei zwei Mappen dann zB so:

Sub b()
Dim DateiDialog As FileDialog
Dim wbPfad As String
Dim wbQuelle As Workbook
Dim wsQuellBlatt As Worksheet
Dim objDateiSystem As Object
Dim objDatei As Object
'Bildschirm-Aktualisierung ausschalten
Application.ScreenUpdating = False
Set objDateiSystem = CreateObject("Scripting.FileSystemObject")
Set DateiDialog = Application.FileDialog(msoFileDialogFilePicker)
'Dateiauswahl über Dialog...
With DateiDialog
.Title = "Bitte Quell-Arbeitsmappe wählen"
.AllowMultiSelect = False
If .Show  -1 Then
MsgBox "Vorgang abgebrochen", vbInformation
Exit Sub
Else: wbPfad = .SelectedItems(1)
End If
End With
'...mit dem entsprechenden Datei-Pfad
With ThisWorkbook
'...die Quell-Datei öffnen
Set wbQuelle = Workbooks.Open(Filename:=wbPfad)
'...Zugriff auf Datei über Datei-System für Erstelldatum
Set objDatei = objDateiSystem.getfile(wbQuelle.FullName)
'...das Quell-Blatt über den Code-Namen definieren...
Set wsQuellBlatt = BlattCodeHolen(ActiveWorkbook, "Vorlage")
'...und in diese Mappe ans Ende kopieren
wsQuellBlatt.Copy after:=.Sheets(.Sheets.Count)
'...dem kopierten Blatt das Erstelldatum der Quell-Datei als Name übergeben
.Sheets(.Sheets.Count).Name = Left(objDatei.DateCreated, 10)
'...Quell-Datei schließen, Änderungen speichern
wbQuelle.Close savechanges:=True
End With
'Bildschirm-Aktualisierung einschalten
Application.ScreenUpdating = True
End Sub
Function BlattCodeHolen(wb As Workbook, BlattCode As String) As Worksheet
' Funktion benötigt um zwischen zwei Mappen auf den Blatt-CodeNamen
' referenzieren zu können
Dim ws As Worksheet
'Blätter in Ziel-Mappe durchgehen...
For Each ws In wb.Worksheets
'Und Blatt-Namen auslesen wenn
'Code-Name übereinstimmt
If ws.CodeName = BlattCode Then
Set BlattCodeHolen = ws
Exit For
End If
Next
End Function

In diesem Code gehe ich jetzt davon aus, dass das Quell-Blatt im CodeNamen "Vorlage" getauft wird.
Passt?
LG
Michael

Sub b() Dim DateiDialog As FileDialog Dim wbPfad As String Dim wbQuelle As Workbook Const wsName As String = "Tabelle1" Dim objDateiSystem As Object Dim objDatei As Object 'Bildschirm-Aktualisierung ausschalten Application.ScreenUpdating = False Set objDateiSystem = CreateObject("Scripting.FileSystemObject") Set DateiDialog = Application.FileDialog(msoFileDialogFilePicker) 'Dateiauswahl über Dialog... With DateiDialog .Title = "Bitte Quell-Arbeitsmappe wählen" .AllowMultiSelect = False If .Show -1 Then MsgBox "Vorgang abgebrochen", vbInformation Exit Sub Else: wbPfad = .SelectedItems(1) End If End With '...mit dem entsprechenden Datei-Pfad With ThisWorkbook '...die Quell-Datei öffnen Set wbQuelle = Workbooks.Open(Filename:=wbPfad) '...Zugriff auf Datei über Datei-System für Erstelldatum Set objDatei = objDateiSystem.getfile(wbQuelle.FullName) '...das gewünschte Blatt in _diese_ Datei kopieren '--> gesuchter Blattname im Quell-Blatt als Konstante definiert (s.o.) ActiveWorkbook.Sheets(wsName).Copy after:=.Sheets(.Sheets.Count) '...dem kopierten Blatt das Erstelldatum der Quell-Datei als Name übergeben .Sheets(.Sheets.Count).Name = Left(objDatei.DateCreated, 10) '...Spalten B, D im kopierten Blatt löschen .ActiveSheet.Columns("B:B").Delete .ActiveSheet.Columns("D:D").Delete '...Quell-Datei schließen, Änderungen speichern wbQuelle.Close savechanges:=True End With 'Bildschirm-Aktualisierung einschalten Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

Kopieren von einer Tabelle in eine Andere

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Kopieren von einer Tabelle in eine Andere

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread