• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Update cell in copy

Thomas Kuriakose

Active Member
Respected Sirs,

I was trying to copy sheets and rename them using the below code.

Code:
Sub CopySheets()
    Dim ws As Worksheet, sh As Worksheet
    Dim Rws As Long, rng As Range, c As Range
    Set sh = Sheets("Overview")
    Set ws = Sheets("CA")

    With sh
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set rng = .Range(.Cells(2, 1), .Cells(Rws, 1))
    End With
    For Each c In rng.Cells
        If WorksheetExists(c.Value) Then
            MsgBox "Sheet " & c & " exists"
        Else:
            ws.Copy After:=Worksheets(Worksheets.Count)
            Worksheets(Worksheets.Count).Name = c.Value
            [D10].Value = ActiveSheet.Name

        End If
    Next c
End Sub
Function WorksheetExists(WSName As String) As Boolean
    On Error Resume Next
    WorksheetExists = Worksheets(WSName).Name = WSName
    On Error GoTo 0
End Function

The template sheet is CA and this has three cells to be updated in D10, H10 and H8 for Name, Number and Type respectively
The cells values are in the table in Overview tab with Name, Number and Type. The name column values are the sheet names also.

a) A2 down has the sheet names on copy and also update value on D10 on copied sheet.
b) The number needs to be updated on H10 on copied sheet as per sheet name reference.
c) The type should be updated on H8 on copied sheet as per sheet name reference.

I was only able to update the name in D10 which is the sheet name, but not able to get the number and type assigned in the copied sheets.

Kindly guide on the code to be used to get this update.

Thank you very much,

with regards,
thomas
 

Attachments

  • Sheet Copy.xlsm
    22.4 KB · Views: 1
Hi Thomas !​
According to your attachment a beginner starter demonstration :​
Code:
Sub CreateSheets()
    Dim V, R&, S$
        V = Sheet1.[A1].CurrentRegion.Value2
        Application.ScreenUpdating = False
    For R = 2 To UBound(V)
        If Evaluate("ISREF('" & V(R, 1) & "'!A1)") Then
            S = IIf(S > "", S & ", ", "") & V(R, 1)
        Else
            Sheet2.Copy , Sheets(Sheets.Count)
            ActiveSheet.Name = V(R, 1)
            [D10] = V(R, 1)
            [H10] = V(R, 2)
            [H8] = V(R, 3)
        End If
    Next
        Application.ScreenUpdating = True
        If S > "" Then MsgBox S, vbInformation, "List of already existing sheets :"
End Sub
Do you like it ? So thanks to click on bottom right Like !
 
Respected Sir,

Brilliant, this is exactly what was required.

Thank you so much for this guidance and your support,

very much appreciated always,

with regards,
thomas
 
Back
Top