VBA Excel-Programm funktioniert nur mit Haltepunkt

Question

Dies ist mein Code zum Kopieren eines Blattes auf ein neues Blatt. Wenn ich das Programm mit Breakpoint auf Workbooks.Open(path) lief, funktionierte es richtig, aber wenn ich ohne den Haltepunkt lief, öffnete es einfach die Arbeitsmappe, ohne ein Blatt zu erstellen.
Ich habe mein Bestes versucht, um den Fehler zu beheben, aber ich konnte nicht das gewünschte Ergebnis erhalten.

Sub CopyCat()  

Dim ws As Worksheet 
Dim no As Integer 
Set ws1 = ActiveSheet 
Dim path As String 

temp_name = InputBox("Enter the Sheet No to be Created", "Enter the Value") 

For Loop1 = 1 To ws1.UsedRange.Rows.Count 
    path = Application.ActiveWorkbook.path & "\" & Application.WorksheetFunction.Trim(Trim(ws1.Cells(Loop1, 1).Value)) & " " & ws1.Cells(Loop1, 2).Value & ".xlsx" 

    Set wb1 = Workbooks.Open(path) 

    'ListBox1.AddItem wb.Name 
    temp_name = "Sheet" & temp_name 

    'error1 = CheckSheet(wb1, temp_name) 
    'If (error1 <> True) Then 
    ws1.Cells(4, 1).Value = "Created" & CStr(Loop1) 
    Set ws = wb1.Worksheets(Sheets.Count) 

    ws.Copy After:=wb1.Sheets(Sheets.Count) 
    Set ws = ActiveSheet 
    ws.Name = temp_name 

    'Call PageSetting 
    wb1.Close SaveChanges:=True 
    ws1.Cells(4, 1).Value = "Created Done" & CStr(Loop1) 
    'Else 
    'wb1.Close SaveChanges:=True 
    'End If 
Next Loop1 

End Sub 


Function CheckSheet(ByVal wb As Workbook, ByVal sSheetName As String) As Boolean 

Dim oSheet As Excel.Worksheet 
Dim bReturn As Boolean 

For Each oSheet In wb.Sheets 

    If oSheet.Name = sSheetName Then 
     bReturn = True 
     Exit For 
    End If 

Next oSheet 

CheckSheet = bReturn 

End Function 

Answer 1

Diese Frage ist ein bisschen vage, also nahm ich ein paar Dinge an, die auf dem von Ihnen bereitgestellten Code basierten.

Sie möchten ein Arbeitsblatt aus einer Arbeitsmappe kopieren, die das Makro in einer anderen Excel-Datei ausführt.

Alle Dateinamen sind im Quellarbeitsblatt, Spalte A aufgeführt - nennen wir es "Interface" Arbeitsblatt.

Sie müssen einen Verweis auf Microsoft Scripting Runtime in Ihrem Projekt hinzufügen, damit das FileSystemObject funktioniert.

Code unten ist nicht sehr gut geschrieben oder optimiert, aber es funktioniert.

Sub CopySht(NamesRange As Range, NameOfSheetToCopy As String) 

Dim fso As FileSystemObject, oFile As File, fPath As String, fNamesArr() As Variant, fFolder As Folder 
Set fso = New FileSystemObject 

Dim InputWb As Workbook, InterfaceWs As Worksheet 
Set InputWb = ThisWorkbook 
Set InterfaceWs = InputWb.Worksheets("Interface") 

Dim SheetToCopy As Worksheet 
Set SheetToCopy = InputWb.Worksheets(NameOfSheetToCopy) 

Set NamesRange = InterfaceWs.Range(NamesRange.Address) 



fNamesArr() = NamesRange.Value 

fPath = InputWb.path 
Set fFolder = fso.GetFolder(fPath) 

Dim i As Integer 

For Each oFile In fFolder.Files 
    For i = LBound(fNamesArr) To UBound(fNamesArr) 
     If oFile.Name = fNamesArr(i, 1) & ".xls" Or oFile.Name = fNamesArr(i, 1) & ".xlsx" Then 

      On Error Resume Next 
      If Not (Workbooks(oFile.Name) Is Nothing) Then 
       Workbooks(oFile.Name).Close SaveChanges:=False 
      End If 

      Workbooks.Open (oFile.path) 

      If Not (CheckSheet(Workbooks(oFile.Name), SheetToCopy.Name)) Then 
       SheetToCopy.Copy After:=Workbooks(oFile.Name).Sheets(1) 
       Workbooks(oFile.Name).Close SaveChanges:=True 
      End If 

      If Not (Workbooks(oFile.Name) Is Nothing) Then 
       Workbooks(oFile.Name).Close SaveChanges:=False 
      End If 

     End If 
    Next i 
Next oFile 


End Sub 

Function CheckSheet(ByVal wb As Workbook, ByVal sSheetName As String) As Boolean 

    Dim oSheet As Excel.Worksheet 
    Dim bReturn As Boolean 

    For Each oSheet In wb.Sheets 

     If oSheet.Name = sSheetName Then 

      bReturn = True 
      Exit For 

     End If 

    Next oSheet 

    CheckSheet = bReturn 

End Function 

Dabei spielt es keine Rolle, ob Sie NamesRange als qualifizierte oder unqualifizierte Bereich Objekt übergeben, wie unten

gezeigt

Sub Wrapper() 

    CopySht Range("A1:A6"), "CopyMe" 
    'CopySht ThisWorkbook.Worksheets("Interface").Range("A1:A6"), "CopyMe" 

End Sub