Save Created sheet with different name

rollis13 · Feb 20th 2022

Do you mean that every sheet has to create it's own template ? Just get rid of the ws Array and the cycle For i.

Just set a variable (ws) to read the name of the sheet from which you launch the macro.

Also I would close the template just after saving it if you don't need it straight away (see note in macro).

Code

Option Explicit
Sub BuildTemplateINm()
    Dim nr     As Long
    Dim cell   As Variant
    Dim lr     As Long
    Dim N$
    Dim ws     As String
    ws = ActiveSheet.Name
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ' Loop through all sheets in sheets array
    Sheets.Add.Name = "NewSheet"
    Range("A1").Value = "Description"
    Range("B1").Value = "Quantity"
    nr = 2
    With Sheets(ws)
        ' Find last row in column with data
        lr = .Cells(Rows.Count, "D").End(xlUp).Row
        ' Loop through all cells in column
        For Each cell In .Range(.Cells(1, "D"), .Cells(lr, "D"))
            ' Check to see if value is numeric and not 0
            If (IsNumeric(cell.Value)) And (cell.Value <> 0) Then
                ' Copy cells C, D, E to columns A, B, C of newsheet
                .Range(.Cells(cell.Row, "C"), .Cells(cell.Row, "E")).Copy
                Sheets("NewSheet").Cells(nr, "A").PasteSpecial Paste:=xlPasteValues
                Application.CutCopyMode = False
                ' Increment nr counter
                nr = nr + 1
            End If
        Next cell
    End With
    ' Name and Save newsheet
    N = ActiveWorkbook.Path & "\" & ws & ".xlsx"
    Sheets("NewSheet").Move
    ActiveWorkbook.SaveAs N, 51
    ActiveWorkbook.Close                          '<- delete if you need the new template open
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "Done! " & ws & " template created."
End Sub

Display More

pantakos · Feb 20th 2022

Yes! This is working Fine ! Thank you, Thank you, Thank you !!!

If I can ask, at the same workgroup , at sheet PROFORMA DRYHIRE , the macro is working fine, but when I press the button and the macro ends , do the job, it redirect to sheet 3.... Why is it doing that? I dont have any redirect to do that, maybe goes to last sheet before PROFORMA DRYHIRE.

If it is not possible to answer that ( due to forum rules) I understand and I can open a new thread.

rollis13 · Feb 20th 2022

That's because you are activating the sheets Sheet(ws(i)).Activate to fetch the data and the last activated sheet will be the last of the ws Array so it's the "3. ...". It isn't necessary to activate a sheet to fetch data from it; just give the right reference to the ranges used.

Now, first of all get rid of the trailing spaces in the sheet names, they only create confusion since they aren't visible.

Then try this:

Code

Option Explicit
Sub BuildInvoiceAll()
    Dim ws     As Variant, sht As Variant
    Dim i      As Long, lr As Long, nr As Long, c As Long
    Dim cell   As Range
    Application.ScreenUpdating = False
    ' Set array of worksheet names to copy from
    ws = Array("1.Power Distribution - Dimmer", "2.POWER CABLES - ADAPTORS", "3.CABLES (OTHER) - CABLE CROSS")
    ' Array of columns to check
    sht = Array("D")
    nr = 15
    Sheets("PROFORMA DRYHIRE").Range("A15:C70").ClearContents
    ' Loop through all sheets in sheets array
    For i = LBound(ws) To UBound(ws)
        ' Loop through all columns in the column array
        For c = LBound(sht) To UBound(sht)
            ' Find last row in column with data
            With Sheets(ws(i))
                lr = .Cells(Rows.Count, sht(c)).End(xlUp).Row
                ' Loop through all cells in column
                For Each cell In .Range(.Cells(1, sht(c)), .Cells(lr, sht(c)))
                    ' Check to see if value is numeric and not 0
                    If (IsNumeric(cell.Value)) And (cell.Value <> 0) Then
                        ' Copy cells C, D, E to columns A, B, C of main sheet
                        Range(.Cells(cell.Row, "C"), .Cells(cell.Row, "E")).Copy
                        Sheets("PROFORMA DRYHIRE").Cells(nr, "A").PasteSpecial Paste:=xlPasteValues
                        ' Increment nr counter
                        nr = nr + 1
                        ' Check to see if rows are full
                        If nr > 70 Then
                            MsgBox "Rows are full"
                            Exit Sub
                        End If
                    End If
                Next cell
            End With
        Next c
    Next i
    Application.ScreenUpdating = True
    MsgBox "Macro complete - Data Stored!"
End Sub

Display More

rollis13 · Feb 20th 2022

Sorry, found a typo, missed a reference to sheet, change this:

Code

Range(.Cells(cell.Row, "C"), .Cells(cell.Row, "E")).Copy

to (note the leading dot):

Code

 .Range(.Cells(cell.Row, "C"), .Cells(cell.Row, "E")).Copy

pantakos · Feb 21st 2022

thank you for your answer! I will try it at night, cos I am at work right now! Thanks a lot. I was wondering, because at the excel there will be a lot of sheets, for the last one code, can it choose all the sheets and leave one out? ie choose all the sheets, except PROFORMA DRYHIRE the one that collects all the data. I have find something at the net but nope, doesnt work well. Thank you!

rollis13 · Feb 21st 2022

If you are using ws Array you will only pick from here, elsewise you could change your macro and add a If/Then, something like this:

Code

If Sheets.Name <> "PROFORMA DRYHIRE" Then
'do something
End If

pantakos · Feb 21st 2022

Quote from rollis13
Sorry, found a typo, missed a reference to sheet, change this:
Code
Range(.Cells(cell.Row, "C"), .Cells(cell.Row, "E")).Copy
to (note the leading dot):
Code
 .Range(.Cells(cell.Row, "C"), .Cells(cell.Row, "E")).Copy

Yeap! Working like a charm ! Thank you!

pantakos · Feb 21st 2022

Quote from rollis13
If you are using ws Array you will only pick from here, elsewise you could change your macro and add a If/Then, something like this:
Code
If Sheets.Name <> "PROFORMA DRYHIRE" Then
'do something
End If

Yes I can try that and let you know !

pantakos · Feb 21st 2022

Can I ask and some other thing? I want to make the below code to work globaly for all sheets (its from the same workgroup), I can manage to do it for just the activesheet but not globaly. (I tried but...)

Code

Sub pasw_inputbox()
    Dim mypassword
    Dim xAddress As String
    xAddress = "E:E"
    Application.ActiveSheet.Columns(xAddress).Hidden = True
tryagain:
    mypassword = InputBox("Enter Password", "Password")
    If mypassword = "makis" Then
    Application.ActiveSheet.Columns(xAddress).Hidden = False
    MsgBox ("Correct")
    Else
If MsgBox("Password incorrect, try again?", vbYesNo, "Wrong password") = vbYes Then
    GoTo tryagain
    Application.ActiveSheet.Columns(xAddress).Hidden = True
    End If
End If
End Sub

Display More

What should I change? Thank you

rollis13 · Feb 21st 2022

Sorry, but this time it's better to start a new thread, the title of this one has nothing to do with this last request.

pantakos · Feb 21st 2022

Quote from rollis13

Sorry, but this time it's better to start a new thread, the title of this one has nothing to do with this last request.

You are absolutely right. As I told you in my previous post, I dont want to go against forum rules! I will open a new one, about this matter. Again, thank you very very much for all the effort and your help! Thank you !!! ?

pantakos · Feb 21st 2022

Thread answered a lot of times! Thank you rollis13

rollis13 · Feb 21st 2022

You're welcome .

Save Created sheet with different name

Participate now!

Share