Problem

Ein Sheet soll aus einer anderen Datei rauskopiert und hier eingelesen werden

Ansatz

Über manuelles einlesen

Lösung

Benutzter Funktion:

' Prüfen ob workbook bereits offen
Function IsWorkbookOpen(strWB As String) As Boolean
   On Error Resume Next
   IsWorkbookOpen = Not Workbooks(strWB) Is Nothing
End Function

Funktion kopiereSheet:

Sub kopiereSheet(zielDatei As String, materialnummer As String)
    Dim ZWB As Workbook
    Dim letzteZeileQuelle, letzteSpalteQuelle As Integer
    Dim QWS As Worksheet, ZWS As Worksheet

    
    ' Debug.Print ZWB.ActiveSheet.Name & "<<<< ZWB VORHER QWS >>>>" & QWS.Name
        
    If Not IsWorkbookOpen(zielDatei) Then
        Application.DisplayAlerts = False
        Workbooks.Open Tabelle1.Cells(2, 2) & zielDatei                
        Application.DisplayAlerts = True
    End If
        
    Set ZWB = Workbooks(zielDatei)                             
    Set QWS = QWB.Worksheets(materialnummer)   ' Quelle
   
    
    ZWB.Sheets.Add after:=ZWB.Worksheets(1)
    ZWB.ActiveSheet.Name = materialnummer
    
    Set ZWS = ZWB.ActiveSheet
        
    ' Finde die letzte Zeile
    letzteZeileQuelle = QWS.Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row + 1
    letzteSpalteQuelle = QWS.Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row + 1
               
    Dim i, j As Integer
    
    For i = 1 To letzteZeileQuelle
        For j = 1 To letzteSpalteQuelle
            ZWS.Cells(i, j) = QWS.Cells(i, j)
        Next j
    Next i
   
   Debug.Print ZWB.ActiveSheet.Name & "<<<< ZWB NACHHER QWS >>>>" & QWS.Name
  
   ZWB.Sheets(1).Activate
End Sub

Problem

Ohne alle Sheets zu durchlaufen wird eine performante Lösung gesucht zu überprüfen, ob ein Sheet oder Workbook bereits geöffnet wurde.

Ansatz

Eine einfache Methode ist unter Benutzung der „On Error Resume Next“ Anweisung eine Prüfen nach der Referenz

Lösung

Prüfen für Workbook

' Prüfen ob workbook bereits offen
Function IsWorkbookOpen(strWB As String) As Boolean
   On Error Resume Next
   IsWorkbookOpen = Not Workbooks(strWB) Is Nothing
End Function

Beispiel:

If Not IsWorkbookOpen(pfad & zielDatei) Then
 ' Schaltet die Meldungen aus, 
 Application.DisplayAlerts = False
 Workbooks.Open pfad & zielDatei        
 ' Schaltet die Meldungen wieder ein 
 Application.DisplayAlerts = True
End If

Prüfen für Worksheet:

Dim QWB As Workbook
Set QWB = Workbooks(„JAN-MARCH.xlsx“)
If WorksheetEx(QWB, aktuelleMaterialNummer) Then…

Function WorksheetEx(WBTest As Workbook, strNam As String) As Boolean
   On Error Resume Next
   WorksheetEx = WBTest.Worksheets(strNam).Index > 0
End Function

Analog für Sheets

Sheets sind Worksheets inklusive Charts, Pivottabellen …

Function SheetEx(strNam As String) As Boolean
   On Error Resume Next
   SheetEx = Sheets(strNam).Index > 0
End Function

Problem

In VBA sollen alle Dateien eines Verzeichnisses eingelesen und ausgegeben werden.

Ansatz

Über das OLE Object scripting.FileSystemObject bekommt Excel die Möglichkeit für diese Operation

Lösung

Mit dem folgenden Code lassen sich alle Dateien eines Verzeichnisses einlesen.

Sub Schaltfläche1_KlickenSieAuf()
' Hole alle Dateien vom Verzeichnis
    Dim fs As Object
    Dim fVerz As Object
    Dim fDatei As Object
    Dim fdateien As Object
    Dim strDat As String
    Dim Zeile As Integer

    Set fs = CreateObject("scripting.FileSystemObject")
    Set fVerz = fs.getFolder("C:\verzeichnis")
    
    Set fdateien = fVerz.Files

    For Each fDatei In fdateien
        If InStr(fDatei, "") > 0 Then
            Zeile = Zeile + 1
            Debug.Print fDatei.Name
        End If
    Next fDatei
End Sub