Excel vba Tabellenbätter umkopieren

[sharky51]

Hallo zusammen und ein frohes Osterfest...gerade in dieser ungewissen Zeit!

Ich nutze die Inhouse-Zeit mich mal wieder mit vba zu beschäftigen.

Ein Problem nervt mich gerade weil ich es nicht lösen kann.
Vielleicht könnt Ihr mir auf die Sprünge helfen?

Ich habe zwei Excel-Dateien mit unterschiedlicher Funktion.
In einer Arbeitsmappe werden täglich Daten generiert und jeweils in einem Blatt abgespeichert. Jedes Blatt bekommt einen eindeutigen Namen, z.B. "Mi 01.04.2020" usw.....
Diese Tagesblätter möchte ich in eine bereits erstellte Mappe umkopieren.
Die Tagesblätter sollen aber in der Quelldatei nicht gelöscht werden.

Jetzt zur Kernfrage:
Wie kann man nun per vba immer die Tagesblätter in die Zieldatei kopieren, ohne Dupletten anzulegen. Ich stehe da gerade auf dem Schlauch.

Vielleicht habt Ihr mir da eine Lösung?

[00202]

Hallo Erich, :19:

also packe folgenden Code in die Datei, in welche du die Tabellenblätter reinkopieren willst: :21:

Code:

Option Explicit
Public Sub Main()
    Dim wksSheet As Worksheet
    Dim objFile As Object
    On Error GoTo Fin
    ' Pfad- und Dateiname anpassen!!!!!!!!!!
    Set objFile = GetObject("C:\Temp\TestDatei.xlsx")
    For Each wksSheet In objFile.Worksheets
        If Not fncSheetExist(ThisWorkbook.Name, wksSheet.Name) Then
            wksSheet.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
        End If
    Next wksSheet
Fin:
    If Not objFile Is Nothing Then objFile.Close False
    Set objFile = Nothing
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
Private Function fncSheetExist(ByVal wkbTemp As String, ByVal strName As String) As Boolean
  On Error Resume Next
  fncSheetExist = Not Workbooks(wkbTemp).Worksheets(strName) Is Nothing
  Err.Clear
End Function

Passe den Pfad- und Dateinamen an. Das ist die Datei, welche die Tagesblätter enthält. Die wird versteckt geöffnet - die Tabellenblätter werden kopiert (wenn noch nicht vorhanden) und wieder geschlossen. :21:

[sharky51]

Hallo Case,

das funktioniert super!
Vielen Dank für Dein Ostergeschenk!
Werde nun Deinen Code verwenden....... und noch ein wenig anpassen.

Ich habe in der Zwischenzeit aber auch ein bisschen gebastelt:

Hier verschiebe ich aber nun doch die gewünschten Blätter. Aber nur die, die eine bestimmte Registerfarbe (mir ist nix besseres eingefallen) haben.
Will ja aus der Quelldatei nicht alles kopieren/verschieben.

Code:

Sub TagesBlatt_Umkopieren()
  iPath = "E:\xxxxx\2020 Auswertungen\"
  strSourceFile = "yyyyy_Monitoring_V1.xlsm"
  strTargetFile = "zzzzz_Monitoring_April_2020.xlsx"
 
  For i = 1 To Application.Worksheets.Count
      wksTab = Worksheets(i).Name
      If Worksheets(i).Tab.ColorIndex = 43 Then
        wksTab = Worksheets(i).Name
        With Workbooks(strTargetFile)
            ThisWorkbook.Worksheets(i).Move After:=.Sheets(.Sheets.Count)
        End With
      End If
      Workbooks(strSourceFile).Activate
  Next i
End Sub

Ich wünsche Dir noch weiter schöne Feiertage und bleibe gesund!!!!!