Excel 365 VBA code to open Excel file from folder and copy data

[DThib]

Hi all,

I need help building a code. The open to the correct folder from input boxes works fine. I end up in the folder holding the data.
But I also need it to take the correct file selected and copy that data to the next empty row in a worksheet
Any ideas. I want to make it simpler than a solution I built for a more complex system.

Thanks in advance,

DThib

 

[mumps]

You could have a FileDialogFolderPicker open up which will allow you to choose the correct folder and then the file to open. Once this is done, the macro can copy your data. What is the name of the sheet containing the data you want to copy? Which cells or range in that sheet do you want to copy and what is the name of the destination sheet?

 

[DThib]

Thanks.
To answer your question. It will be a txt file with the file name and it would copy the range A1:T500. The copy would be added to the "Run Data" tab in the next available row has all the runs will be copied on the same tab in the workbook. so the formulas will do something on another tab.

 

[mumps]

Place this macro in a standard module in your destination workbook and run it from there. Change the sheet name (in red) in the code to match the sheet name of the sheet containing the range to be copied.

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim flder As FileDialog, FileName As String, FileChosen As Integer, wkbSource As Workbook, wsDest As Worksheet
    Set wsDest = ThisWorkbook.Sheets("Run Data")
    Set flder = Application.FileDialog(msoFileDialogFilePicker)
    flder.Title = "Please Select a folder and file."
    flder.InitialFileName = "C:\"
    FileChosen = flder.Show
    FileName = flder.SelectedItems(1)
    Set wkbSource = Workbooks.Open(FileName)
    With wkbSource
        .Sheets("[COLOR="#FF0000"]Sheet1[/COLOR]").Range("A1:T500").Copy wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1, 0)
        .Close savechanges:=False
    End With
    Application.ScreenUpdating = True
End Sub

 

[DThib]

Thanks,

I need it to potentially open a workbook but also a posible text file. Any thoughts?

 

[DThib]

Sorry misspelled "possible"

This keeps defaulting to the c:\ drive location of a folder. I need it to use the location constructed from the elements in a worksheet. The named construct should be the trigger for the location to open.

I think I am missing something.

D

 

[mumps]

What do you mean by:

I need it to use the location constructed from the elements in a worksheet.

The macro will work in copying the range from another Excel workbook. However, text files do not contain sheets or ranges as such. Do you want to copy the entire contents of the text file?

 

[DThib]

Hi mumps,

Sorry for the late reply.
No there is a range that needs to be copied, A1:T500
This is the code, which I'm not sure I have it right:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim flder As FileDialog
    Dim FileName, Firstfolder As String, FileChosen As Integer, wkbSource As Workbook, wsDest As Worksheet
    
   Firstfolder = Sheets("Study Setup").Range("H6")
   Secondlist = Sheets("Study Setup").Range("H13")
   Foldit = "190-" & Secondlist & "*"
   '\\cb-fs01\data archive\Sponsor DFR\DFRu\DFR-007V TK Validation 
   stub = "\\server\data\" & "Sponsor 190\"
   ChDir stub
   Stubbie = stub & Firstfolder & "\" & Foldit
    
    Set wsDest = ThisWorkbook.Sheets("Run Data")
    Set flder = Application.FileDialog(msoFileDialogFilePicker)
     'ChDir Stubbie
    flder.Title = "Please Select a folder and file."
    flder.InitialFileName = Foldit
    FileChosen = flder.Show
    'FileName = flder.SelectedItems(1)
    'Set wkbSource = Workbooks.Open(FileName)
    
    With wkbSource
        .Sheets("Rawdata").Range("A1:T500").Copy wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1, 0)
        .Close savechanges:=False
    End With
    
    Application.ScreenUpdating = True
    
End Sub

Thanks for any help,

DThib

 

[DThib]

Forgot to mention, the file that will be called is a Microsoft CSV file format.

DThib

 

[mumps]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim flder As FileDialog, FileName As String, FileChosen As Integer, wkbSource As Workbook, wsDest As Worksheet
    Set wsDest = ThisWorkbook.Sheets("Run Data")
    Set flder = Application.FileDialog(msoFileDialogFilePicker)
    flder.Title = "Please Select a folder and file."
    flder.InitialFileName = "C:\"
    FileChosen = flder.Show
    FileName = flder.SelectedItems(1)
    Set wkbSource = Workbooks.Open(FileName)
    With wkbSource
        If Right(wkbSource.Name, 3) = "csv" Then
            .Sheets(Mid(wkbSource.Name, 1, WorksheetFunction.Find(".", wkbSource.Name, 1) - 1)).Range("A1:T500").Copy wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1, 0)
            .Close savechanges:=False
        Else
            .Sheets("[COLOR="#FF0000"]Sheet1[/COLOR]").Range("A1:T500").Copy wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1, 0)
            .Close savechanges:=False
        End If
    End With
    Application.ScreenUpdating = True
End Sub

Change the sheet name (in red) in the code to match the sheet name of the sheet containing the range to be copied if you are copying from an Excel file.