one button to rule them all

[mrbab7]

Hi, so i have a quote template that i want to do a few things with at the press of the button when it's all been completed.

1. make a duplicate of the sheet on a new tab and pull the name of that tab from cell L10 (if possible also lock the new tab from changes)
2. then i need it to copy the information from cells on the VO Quote Tab > VO Register tab, pulling the data to the next available line stating at 8 as per below

L10>B8
L11>C8
E17>D8
D43>I8
L13>J8
L9>K8
C12>M8

hope this makes sense, i have making a new tab bit working(macro below), but i'm really struggling to get the other bits to work

if anyone could help i'd be massively greatful, thanks in advance.

Sub Sample1A()
ActiveSheet.Copy , Sheets(Sheets.Count)
Sheets(Sheets.Count).Select
ActiveSheet.Name = ActiveSheet.Range("L10")

End Sub

 

[Skyybot]

Your Workbook is set up as follows? Sheet1("VO Quote"), Sheet2("VO Register"), Sheet3[Added Sheet w/ Sheet1 L10 as Name], Sheet4[Added Sheet w/ Sheet1 L10 as Name], so on and so forth?

 

[Logit]

Or ... you could provide a sample workbook with the required data included. Post it to a download website and provide the link here so the workbook can be reviewed.

 

[mrbab7]

Spreadsheet

probably the easier option, sorry should have posted at the start.

 

[Skyybot]

Try this on a copy of your Workbook as unexpected results may occur. Please note comments (in green font) where you will need to change to suit your needs.

Option Base 1
Sub quoteProg()
Dim wb As Workbook, wsQuote As Worksheet, wsReg As Worksheet, wsCopy As Worksheet
Dim quoteData(7), quoteRng As Range, regRng As Range, i As Long, rng As Range, cpy2Rng As Range, rowNum As Long
Application.ScreenUpdating = False
Set wb = Workbooks("Book1"): Set wsQuote = wb.Worksheets("VO Quote"): Set wsReg = wb.Worksheets("VO Register") 'Change Workbook ("Book1") name accordingly
Set quoteRng = Union(wsQuote.Range("L10"), wsQuote.Range("L11"), wsQuote.Range("E17"), wsQuote.Range("D43"), _
    wsQuote.Range("L13"), wsQuote.Range("L9"), wsQuote.Range("C12"))
Set cpy2Rng = wsReg.Range("B8:B" & wsReg.UsedRange.Rows.Count)
For Each rng In cpy2Rng
   If IsEmpty(rng) Then
        rowNum = rng.Row
        Exit For
    End If
Next rng
Set regRng = Union(wsReg.Range("B" & rowNum), wsReg.Range("C" & rowNum), wsReg.Range("D" & rowNum), _
    wsReg.Range("I" & rowNum), wsReg.Range("J" & rowNum), wsReg.Range("K" & rowNum), wsReg.Range("M" & rowNum))
i = 1
For Each rng In quoteRng
    quoteData(i) = rng.Value
    i = i + 1
Next rng
i = 1
For Each rng In regRng
    rng.Value = quoteData(i)
    i = i + 1
Next rng
wsQuote.Copy After:=wb.Sheets(wb.Sheets.Count)
Set wsCopy = wb.Sheets(wb.Sheets.Count)
With wsCopy
    .Name = wsQuote.Range("L10").Value
    .Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=True 'Change password to one of your choosing
End With
Application.ScreenUpdating = True
End Sub

 

[mrbab7]

hey @Skyybot thanks for you help, i loaded it into the worksheet, but it didn't seem to work. it was copying to another tab, but it didn't pull the info to the table and came up with a code 400?

 

[mrbab7]

also complete noob question here...is the workbook name the same as the save file name?

 

[mrbab7]

sorry to bump this, but any additional help would really be appreciated...thanks