Save new file excel with filename cell value - excel

Question

I need to generate many .xls files
renamed as the name contained in row A1, A2, A3 ....
example: NAME1.xls, NAME2.xls ...
and the new generated file must contain only the cells contained in the markers ####
(see IMG...cellD4:T32)
the markers change manually entered by me.
I tried this code only to save new .xls files
but it does not work....I do not know how to do the rest
Private Sub CommandButton1_Clickl()
Dim path As String
Dim filename1 As String
path = "C:\"
filename1 = Range("A1").Text
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=path & filename1 & ".xls", FileFormat:=x1OpenXMLWorkbook
Application.DisplayAlerts = True
ActiveWorkbook.Close
End Sub

Answer 1

Okay here ya go. This should grab the chunk of the original workbook you're looking for and save it as multiple new workbooks.
Option 1 removes formatting
Private Sub CommandButton1_Clickl()
Dim wksht As Worksheet
Set wksht = ActiveSheet
Dim path As String
path = "C:\test\"
If Len(Dir(path, vbDirectory)) = 0 Then
MkDir path
End If
Dim arr() As Variant
arr = wksht.Range("C3:U33").value
Dim wb As Workbook
Dim i As Long
For i = 1 To ActiveSheet.Range("A1").End(xlDown).Row
Set wb = Application.Workbooks.Add
wb.Sheets(1).Range("A1", Cells(UBound(arr), UBound(arr, 2))).value = arr
wb.SaveAs filename:=path & wksht.Range("A" & i).value & ".xlsx"
wb.Close
Next i
End Sub
Option 2 keeps formatting
Private Sub CommandButton1_Clickl()
Dim wksht As Worksheet
Set wksht = ActiveSheet
Dim path As String
path = "C:\test\"
If Len(Dir(path, vbDirectory)) = 0 Then
MkDir path
End If
Dim dataRange As Range
Set dataRange = wksht.Range("C3", wksht.UsedRange.SpecialCells(xlCellTypeLastCell))
Dim wb As Workbook
Dim i As Long
For i = 1 To wksht.Range("A" & wksht.rows.count).End(xlUp).Row
Set wb = Application.Workbooks.Add
dataRange.Copy wb.Sheets(1).Range("A1", wb.Sheets(1).Cells(dataRange.rows.count, dataRange.Columns.count))
wb.SaveAs filename:=path & wksht.Range("A" & i).value & ".xlsx"
wb.Close
Next i
End Sub
but note that the starting point is still C3 based on the example given.
Option 3 keeps formatting and selects the range between the 2 cells with #### in them
Private Sub CommandButton1_Clickl()
Dim wksht As Worksheet
Set wksht = ActiveSheet
Dim path As String
path = "C:\test\"
If Len(Dir(path, vbDirectory)) = 0 Then
MkDir path
End If
Dim rngeStart
Dim rngeEnd
Set rngeStart = wksht.UsedRange.Find(What:="####", LookIn:=xlValues, LookAt:=xlWhole)
Set rngeEnd = wksht.UsedRange.FindNext(After:=rngeStart)
Dim dataRange As Range
Set dataRange = wksht.Range(rngeStart, rngeEnd)
Dim wb As Workbook
Dim i As Long
For i = 1 To wksht.Range("A" & wksht.rows.count).End(xlUp).Row
Set wb = Application.Workbooks.Add
dataRange.Copy wb.Sheets(1).Range("A1", wb.Sheets(1).Cells(dataRange.rows.count, dataRange.Columns.count))
wb.SaveAs filename:=path & wksht.Range("A" & i).value & ".xlsx"
wb.Close
Next i
End Sub
Option 5 keeps row heights and column widths
Private Sub CommandButton1_Clickl()
Dim wksht As Worksheet
Set wksht = ActiveSheet
Dim path As String
path = "C:\test\"
If Len(Dir(path, vbDirectory)) = 0 Then
MkDir path
End If
Dim rngeStart
Dim rngeEnd
Set rngeStart = wksht.UsedRange.Find(What:="####", LookIn:=xlValues, LookAt:=xlWhole)
Set rngeEnd = wksht.UsedRange.FindNext(After:=rngeStart)
Dim dataRange As Range
Set dataRange = wksht.Range(rngeStart, rngeEnd)
Dim newDataRange As Range
Dim wb As Workbook
Dim i As Long
Dim j As Long
Dim k As Long
For i = 1 To wksht.Range("A" & wksht.Rows.Count).End(xlUp).Row
Set wb = Application.Workbooks.Add
Set newDataRange = wb.Sheets(1).Range("A1", wb.Sheets(1).Cells(dataRange.Rows.Count, dataRange.Columns.Count))
dataRange.Copy newDataRange
For j = 1 To dataRange.Columns.Count
newDataRange.Cells(1, j).ColumnWidth = dataRange.Cells(1, j).ColumnWidth
Next j
For k = 1 To dataRange.Rows.Count
newDataRange.Cells(k, 1).RowHeight = dataRange.Cells(k, 1).RowHeight
Next k
wb.SaveAs filename:=path & wksht.Range("A" & i).Value & ".xlsx"
wb.Close
Next i
End Sub

Answer 2

Try this:
Sub filename()
Dim i As Integer
For i = 1 To 32
ChDir "C:\path\"
ActiveWorkbook.SaveAs Filename:= _
"C:\path\" & Range("A" & i).Value & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Next i
End Sub
Note: Don't use "C:\" choose another folder. Probably you will need admin permissions to save there.