Create folder and workbook inside

[Ingolf]

Hello,

I need help with some VBA cod to make folder with the name found in cell A2 and in that folder make workbook with the name find in cell B2.
It's possible?

 

[Ingolf]

@GTO
Please a last help!!!!

 

[GTO]

Wow, EXCELENT it work like a charm. Thank you very much.
Now if you can tell me how I can copy date between column E and AZ and paste special in file new created. Thank you

Greetings Ingolf,

It would be a little easier if all the info is included. Copy Columns E to AZ from the "TEMPLATE" sheet? Also, do you mean copy data? Finally, the entire columns?

For instance, if we are just wanting to 'copy' the values and do not care about formatting (borderlines, interior color or 'highlighting' and such), then we wouldn't really need to copy.

I hope that makes sense,

Mark

 

[Ingolf]

Greetings GTO,

I'm sorry that I don't mention from the beggining, but I belive I can do...I was wrong.
Yes I need to copy range from E1 to AZ50 from the "TEMPLATE" sheet in the new file created, but I need the formating also (something like copy - paste special). In the new file paste special from cell A1. Thank you very much.

 

[GTO]

Okay, try changing the last bit of the Sub in post #8 to:

    With FSO
        If Not .FolderExists(ThisWorkbook.Path & "\" & wks.Range("A2").Text) Then
            .CreateFolder (ThisWorkbook.Path & "\" & wks.Range("A2").Text)
            Set wb = Workbooks.Add(xlWBATWorksheet)
            
            wb.SaveAs ThisWorkbook.Path & "\" & wks.Range("A2").Text & "\" & wks.Range("B2").Text
            
            wks.Range("E1:AZ50").Copy wb.Worksheets(1).Range("A2")
            wb.Close True
        End If
    End With

 

[Ingolf]

I'm sorry but don't work. The error is reference circular How can I change to copy and paste special?

 

[GTO]

I'm sorry but don't work. The error is reference circular How can I change to copy and paste special?

Please post the entire code as you currently have it.

 

[Ingolf]

Sorry for late response but I have problem with my computer.
This is the code:

Sub exa2()
Dim FSO As Object
Dim wb As Workbook
Dim wks As Worksheet
Dim strFileName As String

Const SH_NAME As String = "ETALON" '<--Change to suit

'// Check to ensure the sheet exists //
On Error Resume Next
Set wks = ThisWorkbook.Worksheets(SH_NAME)
On Error GoTo 0

If wks Is Nothing Then
MsgBox SH_NAME & " is missing!", 0, vbNullString
Exit Sub
End If

'// Ensure both suggested filename and foldername are legal //
If Not (IsLegalNam(wks.Range("A2").Value) And IsLegalNam(wks.Range("B2").Value)) Then
MsgBox "On of the suggested names is illegal", vbExclamation, vbNullString
Exit Sub
End If

strFileName = wks.Range("B2").Value

'// Change to suit //
If Not Right(strFileName, 4) = ".xls" Then
strFileName = strFileName & ".xls"
End If

Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO
If Not .FolderExists(ThisWorkbook.Path & "\" & wks.Range("A2").Text) Then
.CreateFolder (ThisWorkbook.Path & "\" & wks.Range("A2").Text)
Set wb = Workbooks.Add
wb.SaveAs ThisWorkbook.Path & "\" & wks.Range("A2").Text & "\" & wks.Range("B2").Text
wks.Range("E1:AZ50").Copy wb.Worksheets(1).Range("A2")
wb.Close True
End If
End With
End Sub

Function IsLegalNam(NameInputted As String, Optional IsFileName As Boolean = True) As Boolean
Dim IllegalCharacters As Variant
Dim i As Long

IsLegalNam = True
IllegalCharacters = IIf(IsFileName, _
Array("/", "\", ":", "*", "?", """", "<", ">", "|", "!"), _
Array(":", "/", "\", "?", "*", "[", "]", "!") _
)

For i = LBound(IllegalCharacters) To UBound(IllegalCharacters)
If CBool(InStr(1, NameInputted, IllegalCharacters(i))) Then
IsLegalNam = False
Exit Function
End If
Next

If Not IsFileName And (Len(NameInputted) > 31 Or UCase(NameInputted) = "HISTORY") Then
IsLegalNam = False
End If
End Function

 

[Ingolf]

Hello GTO,

This is the code:

Sub exa2()
Dim FSO As Object
Dim wb As Workbook
Dim wks As Worksheet
Dim strFileName As String
Const SH_NAME As String = "ETALON" '<--Change to suit
'// Check to ensure the sheet exists //
On Error Resume Next
Set wks = ThisWorkbook.Worksheets(SH_NAME)
On Error GoTo 0
If wks Is Nothing Then
MsgBox SH_NAME & " is missing!", 0, vbNullString
Exit Sub
End If
'// Ensure both suggested filename and foldername are legal //
If Not (IsLegalNam(wks.Range("A2").Value) And IsLegalNam(wks.Range("B2").Value)) Then
MsgBox "On of the suggested names is illegal", vbExclamation, vbNullString
Exit Sub
End If
strFileName = wks.Range("B2").Value
'// Change to suit //
If Not Right(strFileName, 4) = ".xls" Then
strFileName = strFileName & ".xls"
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO
If Not .FolderExists(ThisWorkbook.Path & "\" & wks.Range("A2").Text) Then
.CreateFolder (ThisWorkbook.Path & "\" & wks.Range("A2").Text)
Set wb = Workbooks.Add (xlWBATWorksheet)
wb.SaveAs ThisWorkbook.Path & "\" & wks.Range("A2").Text & "\" & wks.Range("B2").Text
wks.Range("E1:AZ50").Copy wb.Worksheets(1).Range("A2")
wb.Close True
End If
End With
End Sub
Function IsLegalNam(NameInputted As String, Optional IsFileName As Boolean = True) As Boolean
Dim IllegalCharacters As Variant
Dim i As Long
IsLegalNam = True
IllegalCharacters = IIf(IsFileName, _
Array("/", "\", ":", "*", "?", """", "<", ">", "|", "!"), _
Array(":", "/", "\", "?", "*", "[", "]", "!") _
)
For i = LBound(IllegalCharacters) To UBound(IllegalCharacters)
If CBool(InStr(1, NameInputted, IllegalCharacters(i))) Then
IsLegalNam = False
Exit Function
End If
Next
If Not IsFileName And (Len(NameInputted) > 31 Or UCase(NameInputted) = "HISTORY") Then
IsLegalNam = False
End If
End Function

Thank you for your help.

 

[GTO]

I copied your posted code, which other than the sheet name, appears identical to what I posted (well, and the indentatation, but to that in a minute). I ran it without any problems.

A circular reference, AFAIK, is always to do with a formula. Are there formulas in the cells we copied to the new workbook?

Also - I just got 2010 at work, so am fumbling along a bit. What excel version are you using, and if 2007 or later, are you saving with .xlsm or .xlsx (or maybe .xlsb? Dangit! more stuff to learn...) extension?

Mark

 

[Ingolf]

Hello, GTO,

I use excel 2010, an yes it is formula in that range but I don't need them in the new file so that I told you that I need to copy and paste special that range, with cell formated like in that range.

Thank you