Create button with update function for already present sheet

[Mikedd88]

Hello to all,
so recently I am creating an excel sheet which creates a new sheet from data located in master(1st) sheet in the workbook.
I have been following some steps in the below thread which helped me a lot in understanding various functions.
Link with helpful base info
A button("Master button") located in the master(1st) sheet creates buttons for all necessary rows,
for which the user will then be able to create separate sheet representing the data from "Master sheet".

Now I am at the foot of next task, which is creating a another( second) button on the rows 5to54 in columns AE.
Currently buttons in the master sheet in columns AD are only creating the new sheets and view it.
But should the user update any number in master sheet on row 5to54 in columns C to AC,
the changes are not reflected by button in columns AE.
Furthermore I want to restrict any future update in the new sheets on the location A30:CL68.
Recap: New button fuction is to take data from master sheet C5:AC54 and pastes data to existing appropriate sheet (named by column E on master) to location A5:E26.

Master Button code:

Sub MakeBtn()

Dim rng As Range
Dim btn As Object

    'Loop to make your buttons #1
    For i = 5 To 54
        Set rng = ActiveSheet.Range("AD" & i)
        Set btn = ActiveSheet.Buttons.Add(1, 1, 100, 100)
        
        With btn
            'Set the button location to match the rng that was set above
            .Top = rng.Top
            .Left = rng.Left
            .Width = rng.Width
            .Height = rng.RowHeight
            'Rename the button, change the caption, change the font size, set what it runs when clicked
            .Name = i 'This number will be used in the next routine to know which row is affected
            .Characters.Text = "プロジェクトシート作成・表示"
            .Characters.Font.Size = 10
            .OnAction = "New_Sheet"
        End With
    Next i
    
End Sub

Sub New_Sheet()

Dim myBtn As Object
Dim HomeWS As Worksheet
Dim NewName As String
Dim myWS As Worksheet

Dim WorksheetExists As Boolean

    'Need to determine which button was clicked
    Set myBtn = ActiveSheet.Shapes(Application.Caller)
    
    Set HomeWS = ActiveSheet
    NewName = ActiveSheet.Range("E" & myBtn.Name)


    'Test if the worksheet name already exists
    WorksheetExists = Evaluate("ISREF('" & NewName & "'!A1)")

    If WorksheetExists Then

        Sheets(NewName).Activate
        Sheets(NewName).Range("A1").Select

    Else
       
        'Create new sheet
        Set myWS = Sheets.Add
        myWS.Move after:=HomeWS
        myWS.Name = NewName
        
        'Input Project Name
        Range("B2") = "受注後の立ち上げプロジェクト" & NewName & "案件情報"
        Range("B2").Font.Bold = True
        Range("B2").Font.Size = 14
        
        'Input Title #1
        Range("A4") = "■　基本情報・日程マイルストーン・売上・収益概要"
        Range("A4").Font.Bold = True
        Range("A4").Font.Size = 12
        
    With Range("A5:B5,A6:B6,A7:B7,A8:B8,A9:B9,A10:B10,A11:B11,A12:B12,A13:B13,A14:B14,A15:B15")
        .Merge
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With

    With Range("A16:B16,A17:B17,A18:B18,A19:B19,A20:B20,A21:B21,A22:B22,A23:B23,A24:B24,A25:B25,A26:B26")
        .Merge
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
                         
        'copy and transpose 基本情報項目
        HomeWS.Range("C4").Copy
        myWS.Range("A5").PasteSpecial Transpose:=True
        HomeWS.Range("D4").Copy
        myWS.Range("A6").PasteSpecial Transpose:=True
        HomeWS.Range("E4").Copy
        myWS.Range("A7").PasteSpecial Transpose:=True
        HomeWS.Range("F4").Copy
        myWS.Range("A8").PasteSpecial Transpose:=True
        HomeWS.Range("G4").Copy
        myWS.Range("A9").PasteSpecial Transpose:=True
        HomeWS.Range("H4").Copy
        myWS.Range("A10").PasteSpecial Transpose:=True
        HomeWS.Range("I4").Copy
        myWS.Range("A11").PasteSpecial Transpose:=True
        HomeWS.Range("J4").Copy
        myWS.Range("A12").PasteSpecial Transpose:=True
        
        'copy and transpose 基本情報本案件データ
        
        HomeWS.Rows(myBtn.Name).Columns("C:J").Copy
        myWS.Range("C5").PasteSpecial Transpose:=True
                      
        'copy and transpose 日程マイルストーン項目
        HomeWS.Range("K4:Q4").Copy
        myWS.Range("D5").PasteSpecial Transpose:=True
        'copy and transpose 日程マイルストーン本案件データ
        HomeWS.Rows(myBtn.Name).Columns("K:Q").Copy
        myWS.Range("E5").PasteSpecial Transpose:=True
        
        'copy and transpose 売上・収益概要項目
        HomeWS.Range("S4").Copy
        myWS.Range("A16").PasteSpecial Transpose:=True
        HomeWS.Range("T4").Copy
        myWS.Range("A17").PasteSpecial Transpose:=True
        HomeWS.Range("U4").Copy
        myWS.Range("A18").PasteSpecial Transpose:=True
        HomeWS.Range("V4").Copy
        myWS.Range("A19").PasteSpecial Transpose:=True
        HomeWS.Range("W4").Copy
        myWS.Range("A20").PasteSpecial Transpose:=True
        HomeWS.Range("X4").Copy
        myWS.Range("A21").PasteSpecial Transpose:=True
        HomeWS.Range("Y4").Copy
        myWS.Range("A22").PasteSpecial Transpose:=True
        HomeWS.Range("Z4").Copy
        myWS.Range("A23").PasteSpecial Transpose:=True
        HomeWS.Range("AA4").Copy
        myWS.Range("A24").PasteSpecial Transpose:=True
        HomeWS.Range("AB4").Copy
        myWS.Range("A25").PasteSpecial Transpose:=True
        HomeWS.Range("AC4").Copy
        myWS.Range("A26").PasteSpecial Transpose:=True
        myWS.Range("A5:B26").Font.Bold = True
                
        'copy and transpose 売上・収益概要本案件データ
        HomeWS.Rows(myBtn.Name).Columns("S:AC").Copy
        myWS.Range("C16").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
        myWS.Range("C16:C26").HorizontalAlignment = xlCenter
        
        'Fix Columns width
        
        Columns("D:E").ColumnWidth = 19
        Columns("C").ColumnWidth = 25
        Columns("B").ColumnWidth = 16.5
        Columns("F:CW").ColumnWidth = 2.5
        
        'Fix Rows height
        Rows("5:26").RowHeight = 18
        
    With Range("D16:E26")
        .Merge
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
        
        'Input DWG instruction
        Range("D16") = "図面スクリーンショット添付箇所"
        Range("D16").Font.Bold = True
        Range("D16").Font.Size = 12
        
      
    Range("A5:E26").Select
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlDot
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlDot
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
    Range("A5:E26").Select
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlDot
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlMedium
        End With
    Range("A16:E16").Select
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlMedium
        End With
    Range("C5:C26").Select
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlMedium
        End With
       
    'Input Title #1
    Range("A29") = "■　案件活動・日程・担当者名"
    Range("A29").Font.Bold = True
    Range("A29").Font.Size = 12
    
    'copy Schedule plan
    HomeWS.Range("X65:DI103").Copy
    myWS.Range("A30").PasteSpecial Paste:=xlPasteValues
    myWS.Range("A30").PasteSpecial Paste:=xlPasteFormats
    
    'Fix Columns width
    Columns("A").ColumnWidth = 6
    Columns("F").ColumnWidth = 6
    
    With ActiveSheet
        a = .Range(.Cells(1, 1), .Cells(68, 90)).Address
        .PageSetup.PrintArea = a
        .PageSetup.PaperSize = xlPaperA4
        .PageSetup.Orientation = xlLandscape
        .PageSetup.Zoom = False
        .PageSetup.FitToPagesTall = 1
        .PageSetup.FitToPagesWide = 1
        ActiveWindow.View = xlPageBreakPreview
        
    End With
              
    End If

End Sub

Master sheet:

Example sheet with name based on Master sheet Culumn E


I hope the above explanation makes sense.
I am still very much beginner in VBA, therefore any help is much appreciated.

 

[SeniorNewbie]

Hi Mike,

the first what I see, is that your source range (Master) and the destination range has got different numbers of columns. The second: Just to copy and paste from the master to defined cells in a named sheet, it should work with only a few lines of VBA. To react on Errors needs a little more. The third: I would prefer to set up an userform you can only activate with the mastersheet, a dropdown only with valid destinations and a GO button. Errors are avoided an it's easy to use.

Hello from Germany

Senior