Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Public Sub Excel_Merge_FileDialog()
- Application.ScreenUpdating = False
- 'Set Excel folder path
- Application.FileDialog(msoFileDialogFolderPicker).Show
- sPath = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
- 'catch the file
- sFile = Dir(sPath & "\*.csv")
- 'sFile: the open csv
- Application.FileDialog(msoFileDialogSaveAs).Show
- sSave = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
- 'sSave: save location
- Workbooks.Add
- ActiveWorkbook.SaveAs sSave
- Do While sFile <> "" ' until no file matches
- Workbooks.OpenText sPath & "\" & sFile, _
- Origin:=950, _
- StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
- ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=True, _
- Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
- TrailingMinusNumbers:=True
- 'First file "save as"
- Filename = InStrRev(sSave, "\") + 1
- extension = Len(sSave) - InStrRev(sSave, "\")
- sName = Mid(sSave, Filename, extension)
- 'sName=the name of save file
- Sheets(1).Copy After:=Workbooks(sName).Sheets(1)
- main_tlm
- Workbooks(sFile).Close
- sFile = Dir()
- Loop
- Sheets("工作表1").Select
- ActiveWindow.SelectedSheets.Delete
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement