Exporting Certain Cells to a New CSV - with Custom Headers

[xAcrosonicx]

Hello,

Does anyone know how I could create a button in my workbook to export certain cells into a new CSV file? For example, here is some data:

Cell A1: John
Cell A2: Doe
Cell A3: Irrelevant
Cell A4: Irrelevant
Cell A5: Manager Name
Cell A6: Job Title

I would like to be able to pull cells A1, A2, A5, and A6 into a new CSV file. A1 in the new CSV would have the header label "Firstname", B1 would be "Lastname", C1 would be "Manager", D1 would be "Job TItle" and then it would pull the information from the original file's A1 cell and paste that into the new A2 cell, old A2 would become B2, old A5 would become C2, and old A6 would become D2. Hopefully this makes sense, and I would like to create a Macro where I can just push a button and have it automatically create this file that generates the CSV name data from A1,A2, and "Okta.csv" - so the example would be JohnDoe.csv.

Thanks!

 

[DanteAmor]

Hi and welcome to MrExcel.

Try this:

Sub Macro()
  Dim wb2 As Workbook
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  With ActiveSheet
    Set wb2 = Workbooks.Add
    Range("A1").Resize(1, 4).Value = Array("Firstname", "Lastname", "Manager", "Job TItle")
    Range("A2").Resize(1, 4).Value = Array(.[A1], .[A2], .[A5], .[A6])
    wb2.SaveAs ThisWorkbook.Path & "\" & .[A1] & .[A2] & ".csv", xlCSV
    wb2.Close False
  End With
  
  Application.ScreenUpdating = True
End Sub

 

[xAcrosonicx]

Hi and welcome to MrExcel.

Try this:

Sub Macro()
  Dim wb2 As Workbook
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
 
  With ActiveSheet
    Set wb2 = Workbooks.Add
    Range("A1").Resize(1, 4).Value = Array("Firstname", "Lastname", "Manager", "Job TItle")
    Range("A2").Resize(1, 4).Value = Array(.[A1], .[A2], .[A5], .[A6])
    wb2.SaveAs ThisWorkbook.Path & "\" & .[A1] & .[A2] & ".csv", xlCSV
    wb2.Close False
  End With
 
  Application.ScreenUpdating = True
End Sub

Thank you! The issue with this, though, is that I don't want it to overwrite the existing file (which it did), but rather create a new CSV file automatically and preserve the existing document as well.

 

[DanteAmor]

Thank you! The issue with this, though, is that I don't want it to overwrite the existing file (which it did), but rather create a new CSV file automatically and preserve the existing document as well.

If it already exists and you don't want to overwrite, then what new name do you want to use?

 

[xAcrosonicx]

If it already exists and you don't want to overwrite, then what new name do you want to use?

I would like it to pull the data from cells A1 and A2, then add "Okta", so the full name for my example would be JohnDoeOkta.csv

 

[DanteAmor]

What if the JohnDoeOkta.csv file already exists?

What do you think if we add the date and time to the name (johndoe dd-mm-yyy hh-mm-ss.csv)

 

[xAcrosonicx]

What if the JohnDoeOkta.csv file already exists?

What do you think if we add the date and time to the name (johndoe dd-mm-yyy hh-mm-ss.csv)

It will not already exist anywhere. If it does, I am fine with it either overwriting the existing file or saving as JohnDoeOkta1.csv (I do not want a timestamp).

 

[DanteAmor]

JohnDoeOkta1.csv

What if the JohnDoeOkta1.csv file already exists? Then JohnDoeOkta2.csv and so on?

 

[DanteAmor]

Then JohnDoeOkta2.csv and so on ...

Try this:

Sub Macro()
  Dim wb2 As Workbook, n As Long
  Dim sName As String, suffix As String
  
  Application.ScreenUpdating = False
  With ActiveSheet
    Set wb2 = Workbooks.Add
    Range("A1").Resize(1, 4).Value = Array("Firstname", "Lastname", "Manager", "Job TItle")
    Range("A2").Resize(1, 4).Value = Array(.[A1], .[A2], .[A5], .[A6])
    
    Do
      If sName <> "" And suffix = "" Then
        suffix = "Okta"
      ElseIf Left(suffix, 4) = "Okta" Then
        n = n + 1
        suffix = "Okta" & n
      End If
      sName = ThisWorkbook.Path & "\" & .[A1] & .[A2] & suffix & ".csv"
    Loop While Dir(sName) <> ""
    
    wb2.SaveAs sName, xlCSV
    wb2.Close False
  End With
  
  Application.ScreenUpdating = True
End Sub

 

[xAcrosonicx]

Try this:

Sub Macro()
  Dim wb2 As Workbook, n As Long
  Dim sName As String, suffix As String
 
  Application.ScreenUpdating = False
  With ActiveSheet
    Set wb2 = Workbooks.Add
    Range("A1").Resize(1, 4).Value = Array("Firstname", "Lastname", "Manager", "Job TItle")
    Range("A2").Resize(1, 4).Value = Array(.[A1], .[A2], .[A5], .[A6])
   
    Do
      If sName <> "" And suffix = "" Then
        suffix = "Okta"
      ElseIf Left(suffix, 4) = "Okta" Then
        n = n + 1
        suffix = "Okta" & n
      End If
      sName = ThisWorkbook.Path & "\" & .[A1] & .[A2] & suffix & ".csv"
    Loop While Dir(sName) <> ""
   
    wb2.SaveAs sName, xlCSV
    wb2.Close False
  End With
 
  Application.ScreenUpdating = True
End Sub

This throws the error "bad filename or number" and creates a new blank workbook (Named Book1)