Attribute VB_Name = "toforums"
Sub AllWorkbooks()

   Dim MyFolder As String 'Path collected from the folder picker dialog

   Dim MyFile As String 'Filename obtained by DIR function

   Dim wbk As Workbook 'Used to loop through each workbook

On Error Resume Next

Application.ScreenUpdating = False

'Opens the folder picker dialog to allow user selection

With Application.FileDialog(msoFileDialogFolderPicker)

.Title = "Please select a folder"

.Show

.AllowMultiSelect = False

   If .SelectedItems.Count = 0 Then 'If no folder is selected, abort

MsgBox "You did not select a folder"

      Exit Sub

   End If

MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder

End With

MyFile = Dir(MyFolder) 'DIR gets the first file of the folder

'Loop through all files in a folder until DIR cannot find anymore

y = 1
Do While MyFile <> “”

   'Opens the file and assigns to the wbk variable for future use

   Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)

 '#########         THIS IS WHAT i WANT TO IMPROVE      ############################
Sheets(1).Cells(2, 1).Copy              'copys the selection I'm after
Workbooks("åpne tekstfiler.xlsm").Activate 'opens any sheet you want to store the data
Sheets(1).Cells(y, 2).Select 'choose cell to paste
ActiveSheet.Paste
fx = "B" & y
formel1 = "=MID(" & fx & ",33,10)"
Cells(y, 1).Select
Cells(y, 1).Formula = formel1
Dim myval
myval = Val(Cells(y, 1))
y = y + 1
wbk.Close savechanges:=True


MyFile = Dir 'DIR gets the next file in the folder

Loop

'the numbers I get from the formula gives an error naming it as text or appostrophe in it... I want it to be numbers, so I do the below to fix (bettersolution?)


Range("a:a").Copy
Range("a:a").PasteSpecial xlPasteValues
    Application.CutCopyMode = False


Range("J1:J17").Formula = "=Value(A1)"  'formatted as text, need to format as number
Range("j:j").Copy
Range("j:j").PasteSpecial xlPasteValues
    Application.CutCopyMode = False

Range("a:a").Value = Range("j:j").Value

Range("j:j").Clear

'######################################################################################

Application.ScreenUpdating = True

End Sub

