Macro to select sheet(1) if Sheet(2) not found

[howard]

I would like someone to amend my code so that if sheets(2) does not exit tto open sheets(1)

Your asistance is most appreciated

 With nb.Sheets(2)

 Sub Import()



Dim LR As Long
 
'
     
        Application.ScreenUpdating = False
     Application.EnableEvents = False
     Application.Calculation = xlCalculationManual
    Dim nb As Workbook, ts As Worksheet, A As Variant
    Dim rngDestination As Range
  Sheets(2).Select
 
   
    Set ts = ActiveSheet
   
    On Error Resume Next
    Set rngDestination = ts.[a1]
    On Error GoTo 0
    If rngDestination Is Nothing Then Exit Sub
    ChDir ("C:\My Documents")
MsgBox "90206 will be imported"
 
With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = "C:\My Documents\*Statement*.xlsx"
If .Show = 0 Then Exit Sub
A = .SelectedItems(1)
End With
 
   Application.ScreenUpdating = False
   
   Set nb = Workbooks.Open(A)
   ThisWorkbook.Activate
 
 
  With nb.Sheets(2)
        LR = .Cells(Rows.Count, 1).End(xlUp).Row
        .Range("$A$1:$G$" & LR).AutoFilter Field:=4, Criteria1:="882786"
        .UsedRange.SpecialCells(xlCellTypeVisible).Copy
    End With

   
   
 
 
       rngDestination.PasteSpecial Paste:=xlPasteValues
    rngDestination.PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
      
   
    nb.Close savechanges:=False
 
   
         Application.ScreenUpdating = True
        
     Application.EnableEvents = True
     Application.Calculation = xlCalculationAutomatic
    
    
End Sub

 

[HaHoBe]

Hi howard,

how about

Sub MrE_1223746_161510B_Import()
' https://www.mrexcel.com/board/threads/macro-to-select-sheet-1-if-sheet-2-not-found.1223746/

Dim LR                  As Long
Dim nb                  As Workbook
Dim wsNewWb             As Worksheet
Dim A                   As Variant
Dim rngDestination      As Range

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .Calculation = xlCalculationManual
End With

On Error Resume Next
Set rngDestination = Sheets(2).[a1]
On Error GoTo 0
If rngDestination Is Nothing Then GoTo end_here

ChDir ("C:\My Documents")
MsgBox "90206 will be imported"

With Application.FileDialog(msoFileDialogFilePicker)
  .InitialFileName = "C:\My Documents\*Statement*.xlsx"
  If .Show = 0 Then Exit Sub
  A = .SelectedItems(1)
End With

Set nb = Workbooks.Open(A)
If nb.Worksheets.Count >= 2 Then
  Set wsNewWb = nb.Worksheets(2)
Else
  Set wsNewWb = nb.Worksheets(1)
End If

With wsNewWb
  LR = .Cells(Rows.Count, 1).End(xlUp).Row
  .Range("$A$1:$G$" & LR).AutoFilter Field:=4, Criteria1:="882786"
  .UsedRange.SpecialCells(xlCellTypeVisible).Copy
End With

rngDestination.PasteSpecial Paste:=xlPasteValues
rngDestination.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False

nb.Close savechanges:=False

end_here:
Err.Clear
Set wsNewWb = Nothing
Set nb = Nothing
Set rngDestination = Nothing
With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .Calculation = xlCalculationAutomatic
End With

End Sub

You should avoid using Exit Sub if you have some of the Application-Settings changed at the beginning of the code, instead go to the end where they will be restored.

Ciao,
Holger

 

[Phuoc]

Try change: Set rngDestination = Sheets(2).[a1]

to: Set rngDestination = Sheets(2).Range("A1")

 

[gallen]

Try to set a variable to the sheet 2. if it is nothing, then set it to sheet 1:

Option Explicit

Sub Import()



Dim LR As Long
Dim wsExistingSheet As Worksheet
 
'
     
        Application.ScreenUpdating = False
     Application.EnableEvents = False
     Application.Calculation = xlCalculationManual
    Dim nb As Workbook, ts As Worksheet, A As Variant
    Dim rngDestination As Range
  Sheets(2).Select
 
   
    Set ts = ActiveSheet
   
    On Error Resume Next
    Set rngDestination = ts.[a1]
    On Error GoTo 0
    If rngDestination Is Nothing Then Exit Sub
    ChDir ("C:\My Documents")
MsgBox "90206 will be imported"
 
With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = "C:\My Documents\*Statement*.xlsx"
If .Show = 0 Then Exit Sub
A = .SelectedItems(1)
End With
 
   Application.ScreenUpdating = False
   
   Set nb = Workbooks.Open(A)
   ThisWorkbook.Activate
    
    'Added code:
    On Error Resume Next
    Set wsExistingSheet = nb.Sheets(2)
    If wsExistingSheet Is Nothing Then
        Set wsExistingSheet = nb.Sheets(1)
    End If
    
    With wsExistingSheet
        LR = .Cells(Rows.Count, 1).End(xlUp).Row
        .Range("$A$1:$G$" & LR).AutoFilter Field:=4, Criteria1:="882786"
        .UsedRange.SpecialCells(xlCellTypeVisible).Copy
    End With

   
   
 
 
       rngDestination.PasteSpecial Paste:=xlPasteValues
    rngDestination.PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
      
   
    nb.Close savechanges:=False
 
   
         Application.ScreenUpdating = True
        
     Application.EnableEvents = True
     Application.Calculation = xlCalculationAutomatic
    
    
End Sub

 

[howard]

hi Guys

Many thanks for the help, Holger & Gallen. Your codes work perfectly

 

[gallen]

Apologies, i omitted the

On Error GoTo 0

after the if statement

 

[HaHoBe]

Hi howard,

to be honest: I would only rely on the position of a worksheet in a workbook in order to import data if I were the only person to work with these files. And even then I would integrate some checks to make sure that I have found the proper sheet (e.g. change the value of a given cell in that sheet to a date for check: empty means import, date means pass). But since I do not know why you want to use this approach I'm glad we could help on this one.

Holger