SHARE
TWEET

Untitled

a guest Apr 22nd, 2019 70 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
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top