Clever-Excel-Forum

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?

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:

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!!!!!

sharky51

Case

sharky51