Hello,
Every week I recieve a data report in an excel file. I need to input this data in another program as a CSV file.
This file is very hard to work with as there are multiple merged cells and many blank "spacer" rows and columns.
I have tried to use a macro to unmerge all the cells and then delete all the useless rows and columns to keep only the data in a clean 21X52 cell range and then save as CSV.
The problem is that the unmerging erases all the data and I get only blank cells.
Here is my macro :
I also thought of creating a macro to look through the data range and copy each non-blank cell on a new sheet that I can then save as CSV. However I have no idea how to start this type of macro.
Every week I recieve a data report in an excel file. I need to input this data in another program as a CSV file.
This file is very hard to work with as there are multiple merged cells and many blank "spacer" rows and columns.
I have tried to use a macro to unmerge all the cells and then delete all the useless rows and columns to keep only the data in a clean 21X52 cell range and then save as CSV.
The problem is that the unmerging erases all the data and I get only blank cells.
Here is my macro :
Code:
Sub ExtractC()
Application.ScreenUpdating = False
'Make a copy of the data to work with
Sheets("Sheet1").Copy After:=Sheets(1)
'Cells.Select
'THIS PART ISN'T WORKING AS EXPECTED...
Selection.UnMerge
'Delete unneded rows
Range("1:9,14:14,19:19,24:24,29:29,34:34,39:39,44:44,49:49,54:54,59:60,65:65,70:70,75:75,76:81").Delete Shift:=xlUp
'Delete unneded columns
Range("A:D,F:H,J:L,N:Q,S:T,V:W,Y:Z,AB:AD,AF:AG,AI:AJ,AL:AM,AO:AP,AR:AS,AU:AV,AX:AY,BA:BB,BD:BE,BG:BH,BJ:BK,BM:BN,BP:BQ,BS:BT,BV:BY").Delete Shift:=xlToLeft
Application.ScreenUpdating = True
'Prompt to save as CSV (code modified from https://answers.microsoft.com/en-us/msoffice/forum/msoffice_excel-msoffice_custom-mso_2013_release/vba-excel-code-to-prompt-user-for-directory-to/fbd13feb-4f5d-476b-b468-a02a2d1497a2)
Static DefFileName As String
Dim SaveAsFileName As Variant
If DefFileName = "" Then
DefFileName = Environ("USERPROFILE") & "\CUSM.CSV"
End If
SaveAsFileName = Application.GetSaveAsFilename( _
DefFileName, "CSV Files (*.csv), *.csv")
If VarType(SaveAsFileName) = vbBoolean Then
'Aborted
Exit Sub
End If
ActiveWorkbook.SaveAs SaveAsFileName, xlCSV, CreateBackup:=False
End Sub
I also thought of creating a macro to look through the data range and copy each non-blank cell on a new sheet that I can then save as CSV. However I have no idea how to start this type of macro.