none
Macro to copy a specific tab from mutilple workbooks in a specific folder RRS feed

  • Question

  • I'm trying to copy all tabs called "Finance" from all workbooks in the folder located Received files.

    This is my code...but I keep getting a debug at the "Ws.delete". Can anyone help?

    Sub test()
        Dim FilePath As String, fName As String
        Dim aWB As Workbook, sWB As Workbook
        Dim ws As Worksheet
        Dim ColName As String

        Set aWB = ThisWorkbook

           For Each ws In aWB.Sheets
            If ws.Name <> "Summary" Then
                Application.DisplayAlerts = False
                ws.Delete
                Application.DisplayAlerts = True
            End If
        Next ws

        FilePath = "C:\FinanceDun3\FINANCE\Matt\2017 - AOP\Function Cost - Analysis\Recieved Files" 

        fName = Dir(FilePath & "*.xls")

        Do While fName <> ""
            If fName <> aWB.Name Then
                Set sWB = Workbooks.Open(Filename:=FilePath & fName, UpdateLinks:=0)
                sWB.Sheets("Finance").Move after:=aWB.Sheets(aWB.Sheets.Count)
                sWB.Close False
               
                With aWB.Sheets(aWB.Sheets.Count)
                    .Name = fName
                    .Cells.copy
                    .Cells.PasteSpecial xlPasteValues
                   
                    ColName = Split(.Cells(, .Columns.Count).Address, "$")(1)
                    .Columns("AA:" & ColName).Delete
                End With
            End If
            fName = Dir
        Loop
        Set sWB = Nothing: Set aWB = Nothing
    End Sub



    • Edited by InzieBear Tuesday, December 13, 2016 4:25 PM
    Tuesday, December 13, 2016 4:01 PM

All replies

  • Well - couple possibilities come to mind. The first: the workbook is protected. The second, is that the collection used in the 'For Each ' is changed when you delete the sheet and yet the ws variable is still pointing to it. Rather than do the delete at the point of discovery as you are doing, you might just load the names in an array and delete them in a subsequent For/Next Loop.

    Here is an example of an approach that does work for my systems:

        '...
        Dim varSheetsToDelete As Variant
        Dim strSheetList As String
        Dim intDelete As Integer
        
        strSheetList = ""
        Set aWB = Excel.ThisWorkbook
        For Each ws In aWB.Sheets
             If ws.Name <> "Summary" Then
                 strSheetList = strSheetList & "," & ws.Name
             End If
        Next ws
        If Len(strSheetList) > 0 Then  ' Sheets to be deleted!
            varSheetsToDelete = Split(strSheetList, ",")
            For intDelete = (LBound(varSheetsToDelete) + 1) To UBound(varSheetsToDelete)    '(+1 because The first entry is an empty string)
                If Not aWB.Sheets(varSheetsToDelete(intDelete)) Is Nothing Then
                    Application.DisplayAlerts = False
                    aWB.Sheets(varSheetsToDelete(intDelete)).Delete
                    Application.DisplayAlerts = True
                End If
            Next intDelete
        End If

    Have a great day; Hope this helps!


    -MainSleuth

    Tuesday, December 13, 2016 4:48 PM
  • Hi InzieBear,

    I test your above mentioned code.

    so I try to create "Received Files" folder. create some demo excel files and add "Finance" sheet with demo data.

    then I run the above mentioned code.

    code is working fine on my side. it did not get in to debug on "Ws.delete".

    it delete all the sheets except "Summary".

    all the "Finance" sheet get copied to the current file with File name as sheet name.

    also I try to test with both ".xls" and ".xlsx" extensions and both work correctly.

    Here I want to inform you that your code is working correctly without any error and warning.

    can you tell me which Excel Version you are using to run this code. I had made the test with Excel 2016.

    also I want to know did you got any warning or message when it get in to debug on that line?

    if yes, let us know about that.

    after getting in to debug does your code delete the worksheet successfully and complete the execution of the code? or it get break?

    if possible then please post the picture of the screen when it get in to debug.

    to verify that your code is correct you can try to run it on different machine.

    Regards

    Deepak


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Wednesday, December 14, 2016 12:27 AM
    Moderator
  • Wednesday, December 14, 2016 9:33 AM
  • This is the error I get when I try to run the original source

    Wednesday, December 14, 2016 9:34 AM
  • Hi InzieBear,

    This error occurs when there is no sheet or hidden sheet.

    There is a sheet that name doesn't match with "Summary" that's why it go in to the if condition.

    I want to confirm with you is there any sheet is available that is hidden?

    if yes then try to make it visible it and then try to delete.

    Regards

    Deepak


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Wednesday, December 14, 2016 9:39 AM
    Moderator
  • HI there,

    There is no hidden sheets, nor is there any protection on them.

    Above is the list of tabs I have in each workbook..in the Master file I have Summary and Sheet 1.  What I want is for there to be Summary and then X amount of Finance tabs (1 for each workbook).

    I want to be able to create a workbook for each function ie Finance workbook, Admin workbook, Marketing workbook etc

    Wednesday, December 14, 2016 11:27 AM
  • Does it always fail? Could the (Summary) tab name have a leading or trailing space?


    -MainSleuth Contact information: http://www.toolsleuth.com/contact-form

    Wednesday, December 14, 2016 2:42 PM
  • Hi InzieBear,

    you had mentioned that in each workbook you have these number of sheets.

    but it is not related with the issue because we just copy the "Finance" sheet in the current workbook with it's filename as sheet name and that part of code is working correctly.

    the problem with current workbook which have 2 sheets. Summary and Sheet1.

    so I want to confirm with you that what is there in the sheet1?

    it looks like sheet1 is unnecessary so you want to delete that.

    try to delete the sheet by user interface and check whether you can delete it successfully.

    also try to create a fresh new file and test the code again may solve your issue.

    it is possible that something get corrupt in your current workbook and this can be solve by creating a new workbook.

    also if sheet1 is unnecessary and you are creating the Summary sheet after that then try to just use the sheet1 and rename it as summary.

    if nothing get work from the above given suggestion then try to post the sample demo file. we will test that file on our side and try to solve the issue.

    please let us know about the testing results so that we can try to suggest you further.

    Regards

    Deepak


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Thursday, December 15, 2016 5:44 AM
    Moderator
  • I'm seeing a lot of very similar kinds of questions today.  Try the AddIn below.  That should do what you want.

    http://www.rondebruin.nl/win/addins/rdbmerge.htm

    'Merge every worksheet with a name that contains'


    MY BOOK

    Monday, January 16, 2017 5:18 PM