macro with If and Else to copy if Yes and leave the same if NO

[Jeffreyxx01]

Hi guys,

I have my macro here and I would like it to copy the range if the Cell W5 is Yes and if NO copy just the selected range

I have the macro but the yes/no thing is quite hard.

Thanks for the help.

Sub OpenFile_PW()   
   Dim Fname As String
   Dim Wbk As Workbook
   Dim Sht As Worksheet
   
   Set Sht = ActiveWorkbook.Sheets("PW")
   ChDrive "W:"
   ChDir "W:\Insights Team\ALL ACADEMIC\Reporting\Weekly RAM\Pathways"
   Fname = Application.GetOpenFilename(FileFilter:="xls Files (*.xls*), *.xls*", Title:="Select a file", MultiSelect:=False)
   If Fname = "False" Then
      MsgBox "no file selected"
      Exit Sub
   Else
      Set Wbk = Workbooks.Open(Fname)
      With Wbk.Sheets("Summary for BP")
         Sht.Range("s6:V27").ClearContents
         .Range("i7:L28").Copy
         Sht.Range("s6").PasteSpecial xlPasteValues
      If Range("W5")= Yes
      Sht.Range("W6:W27").ClearContents
         .Range("M7:M28").Copy
         Sht.Range("W6").PasteSpecial xlPasteValues
      Else: Range("W5") = No
         Sht.Range("s6:V27").ClearContents
         .Range("i7:L28").Copy
         Sht.Range("s6").PasteSpecial xlPasteValues
         
Application.CutCopyMode = False
      End With
 Application.DisplayAlerts = False
      Wbk.Close , False
   End If


End Sub

 

[Norie]

Try this.

Sub OpenFile_PW()
   Dim Fname As String
   Dim Wbk As Workbook
   Dim Sht As Worksheet
   
   Set Sht = ActiveWorkbook.Sheets("PW")
   
   ChDrive "W:"
   ChDir "W:\Insights Team\ALL ACADEMIC\Reporting\Weekly RAM\Pathways"
   Fname = Application.GetOpenFilename(FileFilter:="xls Files (*.xls*), *.xls*", Title:="Select a file", MultiSelect:=False)
   
   If Fname = "False" Then
      MsgBox "no file selected"
      Exit Sub
   Else
      Set Wbk = Workbooks.Open(Fname)
      
      With Wbk.Sheets("Summary for BP")
         Sht.Range("s6:V27").ClearContents
         .Range("i7:L28").Copy
         Sht.Range("s6").PasteSpecial xlPasteValues
         
        If Range("W5") = "Yes" Then
            Sht.Range("W6:W27").ClearContents
            .Range("M7:M28").Copy
            Sht.Range("W6").PasteSpecial xlPasteValues
        ElseIf Range("W5") = "No" Then
            Sht.Range("s6:V27").ClearContents
            .Range("i7:L28").Copy
            Sht.Range("s6").PasteSpecial xlPasteValues
        End If
         
      End With
      
    End If
      
    Application.CutCopyMode = False
    Application.DisplayAlerts = False
    Wbk.Close False
   
End Sub

 

[Jeffreyxx01]

Hi Norie,

That seems to work but unfortunately when I use the Yes in W5 it does not overwrite the data from it.

In the Cell W5 I use a data validation Yes No if that changes something?

 

[Jeffreyxx01]

I found the solution to my problem, the code works fine now.
In red was the missing parameters

Sub OpenFile_PW()   Dim Fname As String
   Dim Wbk As Workbook
   Dim Sht As Worksheet
   
   Set Sht = ActiveWorkbook.Sheets("PW Jan")
   
   ChDrive "W:"
   ChDir "W:\Insights Team\ALL ACADEMIC\Reporting\Weekly RAM\Pathways"
   Fname = Application.GetOpenFilename(FileFilter:="xls Files (*.xls*), *.xls*", Title:="Select a file", MultiSelect:=False)
   
   If Fname = "False" Then
      MsgBox "no file selected"
      Exit Sub
   Else
      Set Wbk = Workbooks.Open(Fname)
      
      With Wbk.Sheets("Summary for BP")
        If [COLOR=#ff0000]Sht.[/COLOR]Range("W5") = "Yes" Then
            Sht.Range("S6:W27").ClearContents
            .Range("I7:M28").Copy
            Sht.Range("S6").PasteSpecial xlPasteValues
        ElseIf [COLOR=#ff0000]Sht[/COLOR].Range("W5") = "No" Then
            Sht.Range("S6:V27").ClearContents
            .Range("I7:L28").Copy
            Sht.Range("s6").PasteSpecial xlPasteValues
        End If
         
      End With
      
    End If
      
    Application.CutCopyMode = False
    Application.DisplayAlerts = False
    Wbk.Close False
   
End Sub