Saving as and keep original open

[OverrRyde]

Hi everyone, i am hoping to get a little help with the following.

I found right on these forums a solution to what i wanted to achieve in the following thread, which was to create a CSV file from an XLSM original, but keep the original open.
https://www.mrexcel.com/forum/excel...e-csv-date-same-folder-original-file-vba.html

While this does create the CSV file i need and keep the original open, i was wondering if this can be edited further to only save a range within my original. Is it possible to use the code in the above thread and specify a range to copy but keep the rest of the code the same?

Thanks for the help!

 

[Fluff]

Re: Help with saving as and keep original open

How about

Sub SaveAsCSV()
' Original by AlphaFrog
    Dim strName As String
    Dim Sht As Worksheet
    
    Application.ScreenUpdating = False
    Set Sht = ActiveSheet
    
    strName = ThisWorkbook.path & "\" & ActiveSheet.Name & " " & Format(Date, "mm.dd.yy") & ".csv"
    
    Workbooks.Add (1)
    Sht.Range("[COLOR=#ff0000]A1:F20[/COLOR]").copy ActiveSheet.Range("A1")
    ActiveWorkbook.SaveAs FileName:=strName, FileFormat:=xlCSV
    ActiveWorkbook.Close SaveChanges:=False
    
    Application.ScreenUpdating = True
    
    MsgBox "File has been Created and Saved as:  " & vbCr & strName, , "Copy & Save Report"
    
End Sub

Change the range in red to suit

 

[OverrRyde]

Re: Help with saving as and keep original open

How about

Sub SaveAsCSV()
' Original by AlphaFrog
    Dim strName As String
    Dim Sht As Worksheet
    
    Application.ScreenUpdating = False
    Set Sht = ActiveSheet
    
    strName = ThisWorkbook.path & "\" & ActiveSheet.Name & " " & Format(Date, "mm.dd.yy") & ".csv"
    
    Workbooks.Add (1)
    Sht.Range("[COLOR=#ff0000]A1:F20[/COLOR]").copy ActiveSheet.Range("A1")
    ActiveWorkbook.SaveAs FileName:=strName, FileFormat:=xlCSV
    ActiveWorkbook.Close SaveChanges:=False
    
    Application.ScreenUpdating = True
    
    MsgBox "File has been Created and Saved as:  " & vbCr & strName, , "Copy & Save Report"
    
End Sub

Change the range in red to suit

This is great Fluff! It works awesomely! However, now i realize that my problem continues because i am selecting the whole range and it is returning an error because the data doesn't exist. Let me explain:

This is a simple form i am creating that has a drop-down list in column A where i select a persons name. Column B then pulls a username by VLOOKUP with the following:

=IF(A2="","",VLOOKUP(A2,List!A:B,2,FALSE))

This is repeated for 30 rows for different names/usernames, but i don't always fill all 30 rows.. I may only need to do 5 rows now, and maybe 10 next time. Which is why i needed to select a range to save instead of the whole thing. The range in question would be B2 to N31 as A1 is not needed on the CSV file and row 1 is my headers.

The error i am getting now in the CSV file is #REF ! but i am not sure why, but i suspect the new files, when creating, is still looking for the VLOOKUP data that should no longer exist in the new CSV file.

What am i missing?
Thanks!

 

[Fluff]

Re: Help with saving as and keep original open

OK, try this

Sub SaveAsCSV()
' Original by AlphaFrog
    Dim strName As String
    Dim Sht As Worksheet
    
    Application.ScreenUpdating = False
    Set Sht = ActiveSheet
    
    strName = ThisWorkbook.path & "\" & ActiveSheet.Name & " " & Format(Date, "mm.dd.yy") & ".csv"
    
    Workbooks.Add (1)
    ActiveSheet.Range("A1:M30").Value = Sht.Range("B2:N31").Value
    ActiveWorkbook.SaveAs FileName:=strName, FileFormat:=xlCSV
    ActiveWorkbook.Close SaveChanges:=False
    
    Application.ScreenUpdating = True
    
    MsgBox "File has been Created and Saved as:  " & vbCr & strName, , "Copy & Save Report"
    
End Sub

 

[OverrRyde]

Re: Help with saving as and keep original open

OK, try this

Sub SaveAsCSV()
' Original by AlphaFrog
    Dim strName As String
    Dim Sht As Worksheet
    
    Application.ScreenUpdating = False
    Set Sht = ActiveSheet
    
    strName = ThisWorkbook.path & "\" & ActiveSheet.Name & " " & Format(Date, "mm.dd.yy") & ".csv"
    
    Workbooks.Add (1)
    ActiveSheet.Range("A1:M30").Value = Sht.Range("B2:N31").Value
    ActiveWorkbook.SaveAs FileName:=strName, FileFormat:=xlCSV
    ActiveWorkbook.Close SaveChanges:=False
    
    Application.ScreenUpdating = True
    
    MsgBox "File has been Created and Saved as:  " & vbCr & strName, , "Copy & Save Report"
    
End Sub

Thank you so much Fluff!! this worked great! I just adjusted the range to include my Row 1 as this is my header row still needed in the CSV file, but other than that, this works perfectly!!

thank you so much!

 

[Fluff]

Re: Help with saving as and keep original open

Glad to help & thanks for the feedback