Macro to open specific folder

[Buns1976]

Hi Everyone,

I have the macro below on a button in a worksheet and I want it to open "C:\Users\HOME\Dropbox\DSR DAILY IMPORT" so we can select a file
which it does BUT it also opens "My Documents" folder as well? I'm not seeing why that is happening?

Thank you!

​[COLOR=#333333]Sub Macro1()[/COLOR]<code style="font-style: inherit; font-weight: inherit; margin: 0px; padding: 0px; line-height: 12px;">'
' Macro1 Macro()

Dim MyFolder As String
MyFolder = "C:\Users\HOME\Dropbox\DSR DAILY IMPORT"
ActiveWorkbook.FollowHyperlink MyFolder
Dim wkbCrntWorkBook As Workbook
Dim wkbSourceBook As Workbook
Dim rngSourceRange As Range
Dim rngDestination As Range
Set wkbCrntWorkBook = ActiveWorkbook
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa; *.csv"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
Workbooks.Open .SelectedItems(1)
Set wkbSourceBook = ActiveWorkbook
Set rngSourceRange = Application.InputBox(prompt:="Select source range", Title:="Source Range", Default:="A1:I400", Type:=8)
wkbCrntWorkBook.Activate
Set rngDestination = Application.InputBox(prompt:="Select destination cell", Title:="Select Destination", Default:="A1", Type:=8)
rngSourceRange.Copy rngDestination
wkbSourceBook.Close False
End If
End With
End Sub</code>

 

[Buns1976]

Hey Mumps,

Not sure what is going on? This macro is being run from a button on sheet "LOTTERY" and should be putting the imported data in
sheet "POS IMPORT" which is HIDDEN. What it is doing instead is putting it in the "LOTTERY" sheet I assume because that is the
sheet that is open?

The original macro below does that just fine, the only thing it is missing opening the correct
folder which is "C:\Users\HOME\Dropbox\LOTTERY-PLU DAILY IMPORT".

Thank You!!

[/COLOR]Sub IMPORT_PLUs()    Dim wkbCrntWorkBook As Workbook
    Dim wkbSourceBook As Workbook
    Dim rngSourceRange As Range
    Dim rngDestination As String
    Set wkbCrntWorkBook = ActiveWorkbook
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa; *.csv"
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            Workbooks.Open .SelectedItems(1)
            Set wkbSourceBook = ActiveWorkbook
            Set rngSourceRange = Application.InputBox(prompt:="Select source range", Title:="Source Range", Default:="A1:H500", Type:=8)
            wkbCrntWorkBook.Activate
            rngDestination = Application.InputBox(prompt:="Select destination cell", Title:="Select Destination", Default:="A1")
            rngSourceRange.Copy Sheets("POS IMPORT").Range(rngDestination)
            Sheets("POS IMPORT").Columns.AutoFit
            wkbSourceBook.Close False
        End If
    End With
End Sub
[COLOR=#333333]

 

[mumps]

Try:

Sub IMPORT_PLUs()
    Dim wkbCrntWorkBook As Workbook
    Dim wkbSourceBook As Workbook
    Dim rngSourceRange As Range
    Dim rngDestination As String
    Set wkbCrntWorkBook = ActiveWorkbook
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .InitialFileName = "C:\Users\HOME\Dropbox\LOTTERY-PLU DAILY IMPORT\"
        .Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa; *.csv"
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            Workbooks.Open .SelectedItems(1)
            Set wkbSourceBook = ActiveWorkbook
            Set rngSourceRange = Application.InputBox(prompt:="Select source range", Title:="Source Range", Default:="A1:H500", Type:=8)
            wkbCrntWorkBook.Activate
            rngDestination = Application.InputBox(prompt:="Select destination cell", Title:="Select Destination", Default:="A1")
            rngSourceRange.Copy Sheets("POS IMPORT").Range(rngDestination)
            Sheets("POS IMPORT").Columns.AutoFit
            wkbSourceBook.Close False
        End If
    End With
End Sub

 

[Buns1976]

Hi Mumps,

I believe that was the trick.

As always thanks so much!!!

 

[mumps]

You are very welcome.