Office: (Office 2016) Excel VBA zwischen geöffneten Dateien wechseln und schließen.

Hi zusammen,

Meine Arbeitsmappe öffnet via VBA die neueste Datei(auch eine Arbeitsmappe) in einem bestimmten Pfad und öffnet diese. Danach werden Daten hieraus kopiert und in die ursprüngliche Arbeitsmappe kopiert.
Ich habe ein Problem beim schließen der zweiten Datei.
Schließe ich sie, bevor ich die Daten in die eigentliche Arbeitsmappe einfüge, geht das Zahlenformat verloren.
Dachte, dann aktiviere ich eben mein eigentliches Arbeitsblatt und kopiere da die Infos rein und schließe dann wieder die andere Datei.
Grundsätzlich ist der Gedanke, glaube ich, gar nicht soooo verkehrt.... aber wie kann ich denn ein Workbook aufrufen, ohne, dass ich den Namen wirklich kenne?
ActiveWorkbook geht ja auch nicht, denn das ist die Datei die das Makro enthält.
Workbooks(Segmentdatei).Close also analog zu dem Workbooks.Open(Segmentdatei) funktioniert irgendwie auch nicht.
Hilfe, bitte!

Code:

Option Explicit

Sub EinlesenSegmentAufteilung()
Dim sName       As String
Dim dDatum      As Date
Dim Pfad        As String
Dim dDatum_neu  As Date
Dim sDatei      As String
Dim lz          As Integer
Dim Segmentdatei As Variant

'Löschung der Inhalte in Tabelle Rückmeldung Segmente
   Sheets("Rückmeldung Segmente").Select
   Range("D6:D26").Select
   Selection.ClearContents
 
'Datei mit Segmentaufteilung im Laufwerk finden

   sName = Dir(p_cstrPfadOriginal & "\Segmentaufteilung\AA-BA\" & "*.xlsx")
   dDatum_neu = FileDateTime(p_cstrPfadOriginal & "\Segmentaufteilung\AA-BA\" & sName)
   sDatei = sName
 
   Do While sName <> ""                     ' Schleife beginnen.
      sName = Dir
      If sName <> "" Then
         dDatum = FileDateTime(p_cstrPfadOriginal & "\Segmentaufteilung\AA-BA\" & sName)
         If dDatum > dDatum_neu Then
            dDatum_neu = dDatum
            sDatei = sName
         End If
      End If
   Loop
 
   Segmentdatei = (p_cstrPfadOriginal & "\Segmentaufteilung\AA-BA\" & sDatei)
     
   Workbooks.Open (Segmentdatei)
   Range("I42:I62").Copy
   ActiveWindow.Close 'an dieser Stelle Schließen funktioniert, allerdings geht das Zahlenformat dann beim einfügen verloren
   Windows(p_cstrWBName).Activate
   Sheets("Rückmeldung Segmente").Select
   Range("D6").Select
   ActiveSheet.Paste
 End Sub

 

Hallo Charlotte,

vielleicht so:

Code:

Option Explicit

Dim p_cstrPfadOriginal As String   '<--- Wert ??

Sub EinlesenSegmentAufteilung()
   Dim sName       As String
   Dim dDatum      As Date
   Dim Pfad        As String
   Dim dDatum_neu  As Date
   Dim sDatei      As String
   Dim lz          As Integer
   Dim Segmentdatei As Variant
  
   Dim WbSeg       As Workbook
   Dim WbAct       As Workbook
   Dim WsAct       As Worksheet

'Löschung der Inhalte in Tabelle Rückmeldung Segmente
   Set WbAct = ActiveWorkbook
   Set WsAct = WbAct.Sheets("Rückmeldung Segmente")
   WsAct.Range("D6:D26").ClearContents

'Datei mit Segmentaufteilung im Laufwerk finden

   sName = Dir(p_cstrPfadOriginal & "\Segmentaufteilung\AA-BA\" & "*.xlsx")
   dDatum_neu = FileDateTime(p_cstrPfadOriginal & "\Segmentaufteilung\AA-BA\" & sName)
   sDatei = sName

   Do While sName <> ""                     ' Schleife beginnen.
      sName = Dir
      If sName <> "" Then
         dDatum = FileDateTime(p_cstrPfadOriginal & "\Segmentaufteilung\AA-BA\" & sName)
         If dDatum > dDatum_neu Then
            dDatum_neu = dDatum
            sDatei = sName
         End If
      End If
   Loop

   Segmentdatei = p_cstrPfadOriginal & "\Segmentaufteilung\AA-BA\" & sDatei
   Set WbSeg = Workbooks.Open(Filename:=Segmentdatei)
  
   WbSeg.ActiveSheet.Range("I42:I62").Copy
 ' ActiveWindow.Close 'an dieser Stelle Schließen funktioniert, allerdings geht das Zahlenformat dann beim einfügen verloren
 ' Windows(p_cstrWBName).Activate
   WsAct.Activate
   WsAct.Paste Destination:=Range("D6")
  
   WbSeg.Close SaveChanges:=False
  
 End Sub

Die Variable "p_cstrPfadOriginal" musste ich provisorisch zu Beginn deklarieren - wird wahrscheinlich bei dir irgendwo anders befüllt.

 

SUPER!!! Vielen lieben Dank, das funktioniert perfekt!