简体   繁体   中英

Excel VBA Folder Path from Cell to import data

I have a macro that pulls in data from a selected spreadsheet. The way I've originally set it up is to open at the current file path location. The user would then select what file to copy the data from and vba does the rest. I would like to change is so the file path gets input in a cell and then the opened location would then be that file path. Below is my current code:

With Workbooks.Open(Application.GetOpenFilename)
Sheets(1).Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows(2).Activate
Range("G24").Select
ActiveSheet.Paste
.Close False
End With

I have something like this that opens based on the file path in the cell. But I ca't seem to figure out how to change my script above

M = Sheets("Meter Data").Range("N12")
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = M
.Show
End With

You need to get the result of the call to FileDialog and pass it into your Open/Copy/Close code.

You should also avoid all those Select 's and handle some exceptions, something like this

Sub Demo()
    Dim wb As Workbook
    Dim rng As Range
    Dim wsCurrent As Worksheet
    Dim DefaultFile As String

    Set wsCurrent = ActiveSheet
    DefaultFile = ActiveWorkbook.Worksheets("Meter Data").Range("N12")
    If Dir(DefaultFile) = vbNullString Then
        MsgBox DefaultFile & vbNewLine & "does not exist." & vbNewLine & "What Now?"
    Else
        With Application.FileDialog(msoFileDialogOpen)
            .AllowMultiSelect = False
            .InitialFileName = DefaultFile
            .Show
            If .SelectedItems.Count > 0 Then
                Set wb = Workbooks.Open(.SelectedItems(1))
                With wb.Sheets(1)
                    Set rng = .Range(.Range("A1").End(xlToRight), .Range("A1").End(xlDown))
                    rng.Copy wsCurrent.Range("G24")
                    wb.Close False
                End With
            End If
        End With
    End If
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM