Программа VBA Excel работает только с точкой останова

excel vba excel-vba

438 просмотра

1 ответ

Это мой код для копирования листа на новый лист. Когда я запускал программу с точкой останова, Workbooks.Open(path)она работала правильно, но когда я запускал без точки останова, она просто открывала рабочую книгу без создания какого-либо листа.
Я изо всех сил старался исправить ошибку, но не смог получить желаемый результат.

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
Автор: Manoj Mohan Источник Размещён: 08.11.2019 11:12

Ответы (1)


-1 плюса

Этот вопрос немного расплывчатый, поэтому я предположил несколько вещей на основе предоставленного вами кода.

Вы хотите скопировать лист из книги, в которой выполняется макрос, в другой файл Excel.

Все имена файлов перечислены в исходной таблице, столбец A - назовем ее «Интерфейс».

Вам нужно будет добавить ссылку на Microsoft Scripting Runtime в ваш проект, чтобы FileSystemObject работал.

Код ниже не очень хорошо написан или оптимизирован, но все же работает.

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

Не имеет значения, если вы передаете NamesRange как квалифицированный или неквалифицированный объект диапазона, как показано ниже

Sub Wrapper()

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

End Sub
Автор: hstdggsdtgsdafssarf456 Размещён: 20.08.2016 04:14
32x32