Excel Need some help with VB in Excel

Me__2001

Internet Junkie
Joined
Apr 5, 2004
Messages
4,354
Reaction score
1
Hi Guys, My Boss has asked to create a macro to copy the contents of files that are stored in a directory into one file

I have 50 files in the directory, they aren't an excel spreadsheet either. These files are located in C:\HSDA and have to be opened and converted into delimited files with space so they are in columns. I've come up with this so far, it asks for the location and extension of the files plus it creates a new workbook and puts in the column headings i want

Code:
     Sub Sort()
     	Start = Timer
     
     'define starting value for source file counter
     	I = 0
     'create and save destination sheet[1]
     	Workbooks.Add
     	With ActiveWorkbook
     		.Title = ""
     		.Subject = ""
     		.Author = "Mat"
     		.Keywords = ""
     		.Comments = ""
     	End With
     	'INPUTS
     	mydir = InputBox("Enter full path of file location or press Enter for C:\HSDA :", "directory path")
     	If mydir = "" Then
     	mydir = "C:\HSDA"
     	End If
        myext = InputBox("Enter file extension ie .csv:", "file extension")
        
     	 ActiveWorkbook.SaveAs Filename:=mydir & ".xls", FileFormat:=xlNormal, _
     		Password:="", WriteResPassword:="", ReadOnlyRecommended:=True _
     		, CreateBackup:=False
     	'define variables	[2]
     	ActiveCell.FormulaR1C1 = "Crank Angle"
     	Range("A1").Select
     	ActiveCell.FormulaR1C1 = "PCyl1"
     	Range("B1").Select
     	ActiveCell.FormulaR1C1 = "PCyl2"
     	Range("C1").Select
     	ActiveCell.FormulaR1C1 = "Pushrod"
     	Range("D1").Select
     	ActiveCell.FormulaR1C1 = "Injector"
     	Range("E1").Select

I have this bit as well that converts the files and copies its content but i need it to paste it into the file i've created, close the source file and move onto the next one

Code:
   ChDir "C:\HSDA"
  	Workbooks.OpenText Filename:="C:\HSDA\*.1", Origin:=xlMSDOS, _
  		StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
  		ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=False, _
  		Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3 _
  		, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
  	ActiveWindow.SmallScroll Down:=-9
  	Range(Selection, Selection.End(xlToRight)).Select
  	Range(Selection, Selection.End(xlDown)).Select
  	Selection.Copy

Anyone out there able to help me?
 
Back
Top