add newsheets with name in the select cell or range with the same specific title row and format, and copy the row specified in the select cell below

[david2005wang]

Dear Gentleman,

I have one overal document register sheet (hse)-pic1, with sampe of three different registers of document reference number in three row from 1 to 3. (later the row number may increase to 100rows)

First, I wanna to use VBA (macro) to creat one command button in the sheet(HSE) the first pic to create one or more different newsheets with the sheetname as my selection the cell in F column such as SWM, and

then, fill the first row of the new create sheet (SWM) with the same contents and format in another sheet (model) pic2 from column A to column H; same kind of copy the first row from column A to column H with format in the sheet(model) to the the first row of sheet (SWM) .

last, copy the row with the same contents and format in the select row of the cell (SWM) from column A to column H in overall document register sheet (HSE) to the second row of new create sheet (SWM) from column A to column H as the final pic3;

I have one code example for creat the new sheet with the name in the selection cell (SWM) in the sheet (HSE), so how can I auto fill or copy the reqired contents into the new sheet, pls
help me!!!, thanking you so much.

david wang


Private Sub CommandButton2_Click()
'Name macro
'Sub CreateSheets()
'Dimension variables and declare data types
Dim rng As Range
Dim cell As Range

'Enable error handling
On Error GoTo Errorhandling

'Show inputbox to user and prompt for a cell range
Set rng = Application.InputBox(Prompt:="Select cell range:", _
Title:="Create sheets", _
Default:=Selection.Address, Type:=8)

'Iterate through cells in selected cell range
For Each cell In rng

'Check if cell is not empty
If cell <> "" Then

'Insert worksheet and name the worksheet based on cell value
Sheets.Add.Name = cell

End If

'Continue with next cell in cell range
Next cell

'Go here if an error occurs
Errorhandling:

'Stop macro
End Sub

 

[mumps]

It is hard to work with pictures. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach screenshots (not pictures) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[david2005wang]

Dropbox - File Deleted - Simplify your life

www.dropbox.com

Thanking your reply, Dear Mumps

In the sampe of (HSE Document Register.xlsm), there are three different registers of document (HSE Inspection Report, Joint Safety Walkthrough Report, Sub-Contrator HSE Weekly Meeting )reference number in three row from 1 to 3 .

I wanna to use VBA (macro) to creat one command button in the sheet(HSE) to create 1 newsheets with the sheetname as my selection the cell in F column such as SWM, and after newsheet (SWM) create,
then, fill or paste to the first row of the new create sheet (SWM) with the same contents and format in another sheet (Model) from column A to column H (No. Description Com Project No. Dept. Sub. Serial Remark);
last, copy the row with the same contents and format in the select row of the selection cell (SWM) from column A to column H in sheet (HSE) to the second row of newsheet (SWM) ;

the sample attached at the dropbox.



david wang

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your HSE sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. This is a Worksheet_BeforeDoubleClick event macro which is triggered automatically by a double click action. All you have to do is double click on the desired cell in column F of HSE. No button is necessary.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 6 Then Exit Sub
    If Not Evaluate("isref('" & Target.Value & "'!A1)") Then
        Sheets.Add(after:=Sheets(Sheets.Count)).Name = Target
        Sheets("Model").Range("A1:H1").Copy ActiveSheet.Range("A1")
        Sheets("HSE").Range("A" & Target.Row & ":H" & Target.Row).Copy ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Offset(1)
        ActiveSheet.Columns.AutoFit
    Else
        MsgBox ("Sheet '" & Target & "' already exists.")
    End If
    Application.ScreenUpdating = False
End Sub

 

[david2005wang]

Dear Mumps, thank for you very kindly explanation, it 100% working well, also you codes just saving one button which I planed to establish.
Perfect work!!

Thanking you again.

david wang

 

[mumps]

You are very welcome.

 

[david2005wang]

You are very welcome.

Dropbox - File Deleted - Simplify your life

www.dropbox.com

Dear mumps, thanks again for you detailed codes and instruction. It is working very well for those increasing sheet one by one day after day named by the column F.
I was wondering if you can take one second to check the sample excel I uploaded. If at the beginning of constructing of the register document, I wannt to create all sheets with the name selected in the column F (one cell, two cells, or all cells) , and also copy with the format the first line (column A to H) of the sheet (Model) to the first line of each newsheets, and copy to the second line of each newsheets with the same format in the each of selected row of cell in sheet (HSE) from column A to column H in sheet (HSE).

So, one button once time can creat all the sheets, with same title and respective content in the second row.

Thanks so much for your additional instruction.

david wang

 

[mumps]

Try:

Sub CreateSheets()
    Application.ScreenUpdating = False
    Dim rng As Range, srcWS As Worksheet
    Set srcWS = Sheets("HSE")
    With srcWS
        For Each rng In .Range("F3", .Range("F" & .Rows.Count).End(xlUp))
            If Not Evaluate("isref('" & rng.Value & "'!A1)") Then
                Sheets.Add(after:=Sheets(Sheets.Count)).Name = rng
                Sheets("Model").Range("A1:H1").Copy ActiveSheet.Range("A1")
                Sheets("HSE").Range("A" & rng.Row & ":H" & rng.Row).Copy ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Offset(1)
                ActiveSheet.Columns.AutoFit
            End If
        Next rng
    End With
    Application.ScreenUpdating = True
End Sub

 

[david2005wang]

excellent work. Thanking you!

 

[mumps]

My pleasure.