Excel VBA to import CSVs to Multiple Tabs

 My very noddy Macro to import CSV files: 

As part of a recent project, I was required to, as much as possible, automate the production of an excel spreadsheet. Currently we have no facility to do this directly. The plan ended up being to export the many queries as CVSV files. Every month these CSV files are then send to the relevant internal staff via e-mail as a password protected zipped file. 

The process of importing these into a spreadsheet was achieved using a macro. It has been a very long time since I have used VBA for anything because I have always been able to achieve it in SQL or python and as such my macro was cobbled together from stackoverflow answers and a little research. The end result however is a functional piece of code that loops through a range within a config tab to grab a csv and import it into the named tab until it reaches the end of the range. This ends up with 8 tabs being populated from 8 CSVs and minimal work for the analysts. 

In total it took less than a week, which had meetings, to develop the SQL, ETL and macro and it will save the end user around a day a month. 

Here is the code I used: 

VBA Code:

	Sub ImportCSVFileForms(xSheet, xFile)
	'Updateby Extendoffice
	Dim xFileName As Variant
	Dim xSheetName As Variant
	Dim Rg As Range
	Dim xAddress As String
	'Set the ctive worksheet to the one with the meta data
	Worksheets("Monthly Notes").Activate
	' Pik up the file name and path from the sheet
	xFileName = Range("C1").Value & xFile
	' Set the sheet variable
	xSheetName = xSheet
	On Error Resume Next
	' set the starting point
	xAddress = "A2" 'Rg.Address
	' Activate the target sheet in which the data is being pasted
	Worksheets(xSheetName).Activate
	' Add the added
	With ActiveSheet.QueryTables.Add("TEXT;" & xFileName, Range(xAddress))
	.FieldNames = True
	.RowNumbers = False
	.FillAdjacentFormulas = False
	.PreserveFormatting = True
	.RefreshOnFileOpen = False
	.RefreshStyle = xlDeleteCells
	.SavePassword = False
	.SaveData = True
	.RefreshPeriod = 0
	.TextFilePromptOnRefresh = False
	.TextFilePlatform = 936
	.TextFileStartRow = 2
	.TextFileParseType = xlDelimited
	.TextFileTextQualifier = xlTextQualifierDoubleQuote
	.TextFileConsecutiveDelimiter = False
	.TextFileTabDelimiter = True
	.TextFileSemicolonDelimiter = False
	.TextFileCommaDelimiter = True
	.TextFileSpaceDelimiter = False
	.TextFileTrailingMinusNumbers = True
	.AdjustColumnWidth = False
	.B
	.Refresh BackgroundQuery:=False
	End With
	'Format the data to have a border with grey colour
	With Range("A3").CurrentRegion.Borders
	.LineStyle = xlContinuous
	.ColorIndex = xlAutomatic
	.Color = RGB(151, 153, 145)
	.Weight = xlThin
	.TintAndShade = 0
	End With
	' Format the font
	With Range("A3").CurrentRegion.Font
	.Bold = False
	.Italic = False
	.Size = 8
	.Name = Calibri
	End With
	' Make sure the header row is bold.
	Rows(1).Font.Bold = True
	End Sub
	Sub LoopThrough()
	Dim CellValue As Variant
	Dim TabName As Variant
	Dim FileName As Variant
	CellValue = 1
	Worksheets("Monthly Notes").Activate
	For Each Row In Range("B4:C13")
	For Each Cell In Row
	If CellValue Mod 2 <> 0 Then
	TabName = Cell.Value
	CellValue = CellValue + 1
	Else
	FileName = Cell.Value
	Call ImportCSVFileForms(TabName, FileName)
	CellValue = CellValue + 1
	End If
	Next
	Next
	Worksheets("Notes").Activate
	Sheets("Monthly Notes").Delete
	'Kill Connections
	If ActiveWorkbook.Connections.Count > 0 Then
	For i = 1 To ActiveWorkbook.Connections.Count
	ActiveWorkbook.Connections.Item(1).Delete
	Next i
	Else
	End If
	savename = Application.GetSaveAsFilename(fileFilter:="Exel Files (*.xlsx), *.xlsx")
	ActiveWorkbook.SaveAs FileName:=savename, FileFormat:=51
	End Sub

view raw importCSV.vb hosted with ❤ by GitHub