Hi all,
I would like to import data from a closed Excel spreadsheet (.xls, .xlsm or .xlsx) on click into a worksheet called "LOCFile".
On click of the button, it should ask for the file to import from and from which tab/worksheet in the source file (the source file might have multiple worksheets that might differ from file to file so ideally it should ask for the correct worksheet). The data should be copied/imported 1 to 1 and ideally in the source formatting (the file will contain translations so there will be a lot of special characters which should stay the same when copied over).
I've tried several scripts I found online now, but every script is only doing a part of the job (e.g. you can't select which file to import from, it defaults to importing the first worksheet it can find in the locfile, it does not keep source formatting etc.) so quite helpless here :-(
This is a script I found which seems to be working to a certain extend, however, it simply copies the whole workbook (not the content) and adds a new worksheet to the file instead of importing to an existing worksheet.
Quite a noob when it comes to VBA and still learning so any help would be appreciated 
Many thanks!
Sub GetLocFile()
Dim sImportFile As String, sFile As String
Dim sThisBk As Workbook
Dim vfilename As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sThisBk = ActiveWorkbook
sImportFile = Application.GetOpenFilename( _
FileFilter:="Microsoft Excel Workbooks, *.xls; *.xlsx", Title:="Open Workbook")
If sImportFile = "False" Then
MsgBox "No File Selected!"
Exit Sub
Else
vfilename = Split(sImportFile, "\")
sFile = vfilename(UBound(vfilename))
Application.Workbooks.Open Filename:=sImportFile
Set wbBk = Workbooks(sFile)
With wbBk
If SheetExists("NewSheet") Then
Set wsSht = .Sheets("NewSheet")
wsSht.Copy before:=sThisBk.Sheets("Sheet1")
Else
MsgBox "There is no sheet with name :NewSheet in:" & vbCr & .Name
End If
wbBk.Close SaveChanges:=False
End With
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Function SheetExists(sWSName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = Worksheets(sWSName)
If Not ws Is Nothing Then SheetExists = True
End Function
Bookmarks