Code to save new user excel file as CSV where the headers are in a column not row

[AmieD]

good afternoon. I am trying to create a macro that will take the contents of an excel file that had new user details and save it as a csv. The Headers are in column B - B11:B44 with the data in D11:D44. Being the information is running vertically rather than horizontally I am having issues in working this out. The csv file will need to be created in a specified path on a server and only contain two rows of data, the headers and then user record. This will then be picked up by another script and have the new user created in the system. Can anyone please help me out on this one. Thank you

 

[AmieD]

I tried using; Dim Line As String
Dim LineValues() As Variant
Dim OutputFileNum As Integer
Dim PathName As String
Dim RowNum As Integer
Dim SheetValues() As Variant
PathName = Application.DefaultFilePath
OutputFileNum = FreeFile
Open PathName & "\Test.csv" For Output Lock Write As #OutputFileNum
Print #OutputFileNum, "Field1" & "," & "Field2" & "," & "Field3"
SheetValues = Sheets("NewUser").Range("b11:d44").Value
ReDim LineValues(1 To 3)
For RowNum = 1 To 34
For ColNum = 1 To 3
LineValues(ColNum) = SheetValues(RowNum, ColNum)
Next
Line = Join(LineValues, ",")
Print #OutputFileNum, Line
Next

Close OutputFileNum
MsgBox ("Done")

End Sub
But this has the data the wrong way. I need the headers in column B to be on the top. Is there a way to change the loop to do this?

 

[AmieD]

O.k. so managed to just do a work around ... I'm sure there are much more cleaner ways of doing it. But given the 'cost benefit' of me spending a week trying to work out something that seems simple this is what I have done.
Dim ColNum As Integer
Dim Line As String
Dim LineValues() As Variant
Dim OutputFileNum As Integer
Dim PathName As String
Dim RowNum As Integer
Dim SheetValues() As Variant
'Ugly way of copying the data in columns and transposing to rows
'so I can get it to create a csv file with the row data
ActiveWindow.SmallScroll Down:=-45
Range("B11:B40").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=15
Range("B59").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ActiveWindow.SmallScroll Down:=-42
Range("D11:D40").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=15
Range("B60").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveWindow.SmallScroll Down:=3
'This will need to be changed to refer to the file path required
PathName = Application.DefaultFilePath
OutputFileNum = FreeFile
'Open path and create a file called "Test" change this to be what you want to call the file
Open PathName & "\Test.csv" For Output Lock Write As #OutputFileNum
SheetValues = Sheets("NewUser").Range("b59:ae60").Value
ReDim LineValues(1 To 30)
For RowNum = 1 To 2
For ColNum = 1 To 30
LineValues(ColNum) = SheetValues(RowNum, ColNum)
Next
Line = Join(LineValues, ",")
Print #OutputFileNum, Line
Next

Close OutputFileNum

'removing of the copied transposed data as no longer needed
Range("B59:AE60").Select
Selection.ClearContents
Range("a1:a1").Select


MsgBox ("CSV File has been created")

End Sub
Any suggestions on a better way to do it will be appreciated, along with how to append all new users created in a 24 hour period to the same CSV file. So the script to create the new users can be run once daily and not duplicate them.