Excel – Importing external worksheet data into Excel 2010 workbook

Summary

This is a short, but smart macro. It splits & saves the data on the active sheet into different CSV files. The newly created files are stored in a new folder called CSV output at the same location as your Excel file.

---

VBA macro

Sub GenerateCSV()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

iCol = 2                                '### Define your criteria column
strOutputFolder = "CSV output"          '### Define your path of output folder

Set ws = ThisWorkbook.ActiveSheet       '### Don't edit below this line
Set rngLast = Columns(iCol).Find("*", Cells(1, iCol), , , xlByColumns, xlPrevious)
ws.Columns(iCol).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set rngUnique = Range(Cells(2, iCol), rngLast).SpecialCells(xlCellTypeVisible)

If Dir(strOutputFolder, vbDirectory) = vbNullString Then MkDir strOutputFolder
For Each strItem In rngUnique
  If strItem <> "" Then
    ws.UsedRange.AutoFilter Field:=iCol, Criteria1:=strItem.Value
    Workbooks.Add
    ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=[A1]
    strFilename = strOutputFolder & "\" & strItem
    ActiveWorkbook.SaveAs Filename:=strFilename, FileFormat:=xlCSV
    ActiveWorkbook.Close savechanges:=False
  End If
Next
ws.ShowAllData

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

^{Save it in a new VBA module}

---

Understanding the code

iCol = 2                               
strOutputFolder = "CSV output"        

The first line is your criteria column. A 1 would stand for column A, 2 for column B and so on.
Second, we define a folder name where all our CSV files should be saved at. You can also set a fully qualified path like C:\some\folder. Otherwise Excel will create a folder at your Excel file's location

 Set ws = ThisWorkbook.ActiveSheet      

Here we save our current workbook and worksheet in a variable. Its not neccessarry to do this, but since we are dealing with multiple workbooks (newly created ones) I recommend this

Set rngLast = Columns(iCol).Find("*", Cells(1, iCol), , , xlByColumns, xlPrevious)
ws.Columns(iCol).AdvancedFilter Action:=xlFilterInPlace, Unique:=True   
Set rngUnique = Range(Cells(2, iCol), rngLast).SpecialCells(xlCellTypeVisible)

Ok, what does this part? First, we search the last cell only in the criteria column. This must be done before our filtering and is needed later. Then, we use the famous advanced filter method to filter out in place all duplicate values from our criteria column. At last, we save all visible cells in a variable called rngUnique

If Dir(strOutputFolder, vbDirectory) = vbNullString Then MkDir strOutputFolder

Lets see if a folder called CSV output already exists. If not, create one

For Each strItem In rngUnique
  If strItem <> "" Then
  [...]
  End If
Next

Now, we start to loop through all unique values in our variable rngUnique. But empty values are skipped

ws.UsedRange.AutoFilter Field:=iCol, Criteria1:=strItem.Value

An important line. We use the autofilter method and view all lines which match our current unique value. The old advanced filter gets canceled automatically.

Workbooks.Add
ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=[A1]

These two lines create a new empty workbook and copy over only visible cells from our input Workbook

strFilename = strOutputFolder & "\" & strItem

Here we put together the CSV path. We take the current unique value as file name. The extension CSV is appended automatically since we have chosen xlCSV as output format.
Make sure, your unique values do not contain invalid filename characters like < > | / * \ ? " or the corresponding CSV file won't be created

ActiveWorkbook.SaveAs Filename:=strFilename, FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False

The last step is to save the current workbook as a CSV and take the variable strFilename as filename. The CSV delimiter depens on your regional setting delimiter. It's possible to change the fileformat, eg. to tab delimited CSV or Excel 2003 workbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False

The first line speeds up our macro a bit since Excel doesn't need to show every single step of filtering.
The second line suppresses annoying File already exists prompts. Later we enable those functions again

After more frustration and searching on this problem, I think I've come up with the answer. As it turns out, the calculation of column widths in Excel is not simple, and the appearance of columns can depend on many factors and can vary from system to system. One such factor (and maybe the primary one) is the normal font style and size settings. If these are different in another computer, then the columns will automatically adjust to accommodate the normal font.

As it turns out this was the case for my problem. My normal font is Calibri 8 pt, whereas the other machine has the default setting of Calibri 11 pt. The difference in size was causing the problem. I changed the other machine's setting to 8 pt, and the sheet copied over without the size differences (i.e. everything that fit on the original sheet still fit in the new sheet). Note that when I was first trying to debug this issue, I checked the font style and size in the sheet itself, and they matched the original sheet. It's the normal font settings that had to be changed (under "Options").

I found my answer at WindowsSecrets.com and on the MS site. My explanation above was pretty brief, so I recommend taking a look at these pages if you're experiencing similar issues. Hope this helps somebody else.