On Error Resume Next

[StuartHall]

I'm building a consolidation workbook that imports two worksheets from several different workbooks. One sheet is called "Summary", one is called "E-video." Every workbook has a "Summary" sheet, but not every workbook has an "E-video".

My problem is that when I use On Error Resume Next (in order to skip past the workbooks that do not contain an E-Video sheet), VBA is treating all subsequent workbooks the same, only importing Summary sheets and not importing ANY E-Video sheets.

Does anyone have a solution?

Sub ManualStudiesConsolidation()
  Dim Filter As String, Title As String, msg As String
    Dim i As Integer, FilterIndex As Integer
    Dim Filename As Variant
       
    ' File filters
    Filter = "Excel Files (*.xlsm),*.xlsm," & _
            "All Files (*.*),*.*"
    '   Default filter to *.*
        FilterIndex = 3
    ' Set Dialog Caption
    Title = "Select File(s) to Open"
    ' Select Start Drive & Path
    ChDrive ("J")
    ChDir Sheets("Main").Range("f7").Value
    
        With Application
        ' Set File Name Array to selected Files (allow multiple)
        Filename = .GetOpenFilename(Filter, FilterIndex, Title, , True)
        ' Reset Start Drive/Path
        ChDrive Left(.DefaultFilePath, 1)
        ChDir (.DefaultFilePath)
    End With
    ' Exit on Cancel
    If Not IsArray(Filename) Then
        MsgBox "No file was selected"
        Worksheets(Worksheets("Main").Range("e7").Value & " - Summary").Name = "Sheet2"
        Worksheets(Worksheets("Main").Range("e7").Value & " - Video").Name = "Sheet3"
        Exit Sub
    End If
    For i = LBound(Filename) To UBound(Filename)
    
    Application.DisplayAlerts = False
    Workbooks.OpenText Filename:= _
    Filename(i) _
       
     On Error Resume Next
       
            Sheets("Summary").Select
            Cells.Select
            Application.CutCopyMode = False
            Selection.Copy
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheets("Summary").Copy After:=Workbooks("MACRO!.xlsm"). _
        Sheets("Sheet3")
        Sheets("Summary").Name = "Summary" & Format(i, "0")
        
            Sheets("E-Video").Select
            Cells.Select
            Application.CutCopyMode = False
            Selection.Copy
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            
        Sheets("E-Video").Copy After:=Workbooks("MACRO!.xlsm"). _
        Sheets("Sheet3")
        Sheets("E-Video").Name = "E-Video" & Format(i, "0")
        
    
    Next i
    Filename(i).Close SaveChanges:=False
    Application.DisplayAlerts = True
    
    
    Worksheets("Sheet2").Name = Worksheets("Main").Range("e7").Value & " - Summary"
    Worksheets("Sheet3").Name = Worksheets("Main").Range("e7").Value & " - Video"
 End Sub

 

[Norie]

Perhaps.

Option Explicit

Sub ManualStudiesConsolidation()
Dim Filter As String, Title As String, msg As String
Dim i As Integer, FilterIndex As Integer
Dim Filename As Variant

    ' File filters
    Filter = "Excel Files (*.xlsm),*.xlsm," & _
             "All Files (*.*),*.*"
    '   Default filter to *.*
    FilterIndex = 3
    ' Set Dialog Caption
    Title = "Select File(s) to Open"
    ' Select Start Drive & Path
    ChDrive ("J")
    ChDir Sheets("Main").Range("f7").Value

    With Application
        ' Set File Name Array to selected Files (allow multiple)
        Filename = .GetOpenFilename(Filter, FilterIndex, Title, , True)
        ' Reset Start Drive/Path
        ChDrive Left(.DefaultFilePath, 1)
        ChDir (.DefaultFilePath)
    End With

    ' Exit on Cancel
    If Not IsArray(Filename) Then
        MsgBox "No file was selected"
        Worksheets(Worksheets("Main").Range("e7").Value & " - Summary").Name = "Sheet2"
        Worksheets(Worksheets("Main").Range("e7").Value & " - Video").Name = "Sheet3"
        Exit Sub
    End If

    For i = LBound(Filename) To UBound(Filename)

        Application.DisplayAlerts = False
        Workbooks.OpenText Filename:=Filename(i)

        Sheets("Summary").Select
        Cells.Select
        Application.CutCopyMode = False
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                        :=False, Transpose:=False
        Sheets("Summary").Copy After:=Workbooks("MACRO!.xlsm"). _
                                      Sheets("Sheet3")
        Sheets("Summary").Name = "Summary" & Format(i, "0")

        If SheetExists("E-Video") Then
            Sheets("E-Video").Select
            Cells.Select
            Application.CutCopyMode = False
            Selection.Copy
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                            :=False, Transpose:=False

            Sheets("E-Video").Copy After:=Workbooks("MACRO!.xlsm"). _
                                          Sheets("Sheet3")
            Sheets("E-Video").Name = "E-Video" & Format(i, "0")
        End If

        Workbooks(2).Close SaveChanges:=False

    Next i

    Application.DisplayAlerts = True


    Worksheets("Sheet2").Name = Worksheets("Main").Range("e7").Value & " - Summary"
    Worksheets("Sheet3").Name = Worksheets("Main").Range("e7").Value & " - Video"
End Sub



Private Function SheetExists(SheetName As String) As Boolean
' Returns TRUE if a sheet exists in the active workbook
Dim x As Worksheet
    On Error Resume Next
    Set x = ActiveWorkbook.Sheets(SheetName)
    If Err = 0 Then SheetExists = True _
       Else SheetExists = False
End Function

 

[dmt32]

</SPAN>
Dim Filter As String, Title As String</SPAN>
Dim FilterIndex As Integer</SPAN>
Dim Filename As Variant</SPAN>

</SPAN>

Just an observation & may or may not be contributing to your probelm, you have declared the above as local variables however, they all are reserved VBA names. If you want to use variables with like names then suggest prefix with another character e.g. sFilename</SPAN>

Not able test but see if this change in your for loop helps: (note name change to your variables)</SPAN>

</SPAN>
Dim arr As Variant</SPAN>
    Dim shindex As Integer</SPAN>
    Dim wb As Workbook</SPAN>
    Dim sh As Worksheet</SPAN>
   
    arr = Array("Summary", "E-Video")</SPAN>
   
    For i = LBound(sFilename) To UBound(sFilename)</SPAN>
        Application.DisplayAlerts = False</SPAN>
        Set wb = Workbooks.Open(Filename:=sFilename(i))</SPAN>
        On Error Resume Next</SPAN>
        For shindex = 0 To UBound(arr)</SPAN>
            Set sh = wb.Sheets(arr(shindex))</SPAN>
            If Err = 0 Then</SPAN>
                sh.UsedRange.Copy</SPAN>
                sh.UsedRange.PasteSpecial Paste:=xlPasteValues, _</SPAN>
                                          Operation:=xlNone, _</SPAN>
                                          SkipBlanks:=False, _</SPAN>
                                          Transpose:=False</SPAN>
 
                sh.Copy After:=Workbooks("MACRO!.xlsm"). _</SPAN>
                               Sheets("Sheet3")</SPAN>
                sh.Name = arr(a) & Format(i, "0")</SPAN>
                Application.CutCopyMode = False</SPAN>
            Else</SPAN>
            On Error GoTo 0</SPAN>
            End If</SPAN>
        Next shindex</SPAN>
         wb.Close SaveChanges:=False</SPAN>
    Next i</SPAN>

</SPAN>


Dave</SPAN>

 

[dmt32]

sorry, spotted a typo too late to change:

following line should have been:

sh.Name = arr(shindex) & Format(i, "0")

Dave

 

[StuartHall]

Ya Dave, I think you're onto something here. Thanks.

 

[dmt32]

your welcome - thanks for feedback.

Dave

 

[Smitty]

The function needs to go on its own outside of your procedure. Then you would do something like this:

If SheetExists ("E-Video") Then 
  With Sheets("E-Video").Cells
    .Copy
    .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks :=False, Transpose:=False
    .Copy After:=Workbooks("MACRO!.xlsm").Sheets("Sheet3")
    .Name = "E-Video" & Format(i, "0")
  End With
End If