Advertisement
Guest User

Untitled

a guest
Apr 22nd, 2019
106
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Public Sub Excel_Merge_FileDialog()
  2.     Application.ScreenUpdating = False
  3.     'Set Excel folder path
  4.    Application.FileDialog(msoFileDialogFolderPicker).Show
  5.     sPath = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
  6.    
  7.     'catch the file
  8.    sFile = Dir(sPath & "\*.csv")
  9.     'sFile: the open csv
  10.    
  11.    
  12.     Application.FileDialog(msoFileDialogSaveAs).Show
  13.     sSave = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
  14.     'sSave: save location
  15.    
  16.     Workbooks.Add
  17.     ActiveWorkbook.SaveAs sSave
  18.        
  19.     Do While sFile <> "" ' until no file matches
  20.    
  21.         Workbooks.OpenText sPath & "\" & sFile, _
  22.         Origin:=950, _
  23.         StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
  24.         ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=True, _
  25.         Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
  26.         TrailingMinusNumbers:=True
  27.        
  28.         'First file "save as"
  29.      
  30.          Filename = InStrRev(sSave, "\") + 1
  31.          extension = Len(sSave) - InStrRev(sSave, "\")
  32.          sName = Mid(sSave, Filename, extension)
  33.          'sName=the name of save file
  34.        
  35.          
  36.          Sheets(1).Copy After:=Workbooks(sName).Sheets(1)
  37.          
  38.          main_tlm
  39.          
  40.          Workbooks(sFile).Close
  41.        
  42.          sFile = Dir()
  43.     Loop
  44.    
  45.  
  46. Sheets("工作表1").Select
  47. ActiveWindow.SelectedSheets.Delete
  48.  
  49. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement