excel - Copy + Paste a sheet in VBA and rename is based on whether a cell is blank or not - Stack Overflow

admin管理员组

文章数量:1296921

I have a VBA where, when a table is filled out with X number of entries, upon a button click it turns each entry into a form, which is a copy+paste of a blank form document. This works without issue but what I'm trying and failing to do is name the pasted sheet based on a cell input from the original table.

(See table clipped in image) - Right now what happens is that if someone inputs, say, 4 entries, then the sheets.count will call each pasted sheet a number based on the Y integer declared. Since my workbook starts out with 2 sheets, when you run the "generate" button, you get four additional sheets titled, 3, 4, 5, and 6.

What I want to happen is that, IF cell G ("Existing MMR for Link) of any given row is not blank, the sheet created based on that row entry is titled with the value of what is entered into cell G.

Example Table

So based on this example my sheets would be titled "555555", "4", "456786", & "6".

For simplicity I removed most of my Dim String entires but this is still a functional version of what my codes is/does.

Private Sub CommandButton1_Click()

Dim x As Integer
Dim y As Integer

Dim ReqName As String
Dim ReqT As String
Dim Dept As String
Dim currDate As String

x = 8

Do Until Worksheets("FORM").Range("B" & x).Value = ""

ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)

y = Sheets.Count

ReqName = Worksheets("FORM").Range("D2").Value
ReqT = Worksheets("FORM").Range("D3").Value
Dept = Worksheets("FORM").Range("G2").Value
currDate = Worksheets("FORM").Range("G3").Value

Sheets("NISR").Activate
Worksheets("NISR").Cells.Copy
Worksheets(y).Activate
Worksheets(y).Paste

Sheets(y).Name = Sheets.Count

Worksheets(y).Range("B29") = ReqName
Worksheets(y).Range("M29") = ReqT
Worksheets(y).Range("R29") = Dept
Worksheets(y).Range("AA29") = currDate

x = x + 1
y = y + 1

Loop
Worksheets(1).Activate

End Sub 

What I tried to do was declare a separete sub function to contain the if/else statement for the renaming as below. At first I tried including it inside the existing main PrivateSub for but when running this I get a compile error for "expected End Sub". I'm not familiar enough with nestling subs/functions so I don't know if it's a simple matter of where I place the code or if this will even work. I also tried putting it at the end of the main PrivateSub body but that instead gives me a "subscript out of range" error. So I don't know where this needs to go or if it needs to be changed to function. (Range(S36) in the clip below is the cell that the value from cell G is pasted to once the sheet is created.)

Sub IfNotBlank()
   If Not IsEmpty(Range("S36")) Then
     Sheets(y).Name = Worksheets("FORM").Range("G" & x)
   Else
     Sheets(y).Name = Sheets.Count
   End If
End Sub

I have a VBA where, when a table is filled out with X number of entries, upon a button click it turns each entry into a form, which is a copy+paste of a blank form document. This works without issue but what I'm trying and failing to do is name the pasted sheet based on a cell input from the original table.

(See table clipped in image) - Right now what happens is that if someone inputs, say, 4 entries, then the sheets.count will call each pasted sheet a number based on the Y integer declared. Since my workbook starts out with 2 sheets, when you run the "generate" button, you get four additional sheets titled, 3, 4, 5, and 6.

What I want to happen is that, IF cell G ("Existing MMR for Link) of any given row is not blank, the sheet created based on that row entry is titled with the value of what is entered into cell G.

Example Table

So based on this example my sheets would be titled "555555", "4", "456786", & "6".

For simplicity I removed most of my Dim String entires but this is still a functional version of what my codes is/does.

Private Sub CommandButton1_Click()

Dim x As Integer
Dim y As Integer

Dim ReqName As String
Dim ReqT As String
Dim Dept As String
Dim currDate As String

x = 8

Do Until Worksheets("FORM").Range("B" & x).Value = ""

ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)

y = Sheets.Count

ReqName = Worksheets("FORM").Range("D2").Value
ReqT = Worksheets("FORM").Range("D3").Value
Dept = Worksheets("FORM").Range("G2").Value
currDate = Worksheets("FORM").Range("G3").Value

Sheets("NISR").Activate
Worksheets("NISR").Cells.Copy
Worksheets(y).Activate
Worksheets(y).Paste

Sheets(y).Name = Sheets.Count

Worksheets(y).Range("B29") = ReqName
Worksheets(y).Range("M29") = ReqT
Worksheets(y).Range("R29") = Dept
Worksheets(y).Range("AA29") = currDate

x = x + 1
y = y + 1

Loop
Worksheets(1).Activate

End Sub 

What I tried to do was declare a separete sub function to contain the if/else statement for the renaming as below. At first I tried including it inside the existing main PrivateSub for but when running this I get a compile error for "expected End Sub". I'm not familiar enough with nestling subs/functions so I don't know if it's a simple matter of where I place the code or if this will even work. I also tried putting it at the end of the main PrivateSub body but that instead gives me a "subscript out of range" error. So I don't know where this needs to go or if it needs to be changed to function. (Range(S36) in the clip below is the cell that the value from cell G is pasted to once the sheet is created.)

Sub IfNotBlank()
   If Not IsEmpty(Range("S36")) Then
     Sheets(y).Name = Worksheets("FORM").Range("G" & x)
   Else
     Sheets(y).Name = Sheets.Count
   End If
End Sub

• excel
• vba

Share Follow edited Feb 11 at 17:10 Tim Williams 167k88 gold badges100100 silver badges139139 bronze badges asked Feb 11 at 17:04 Darian MarinoDarian Marino 111 bronze badge 3

• 1 Is there only one workbook involved here? The one where your code is running? – Tim Williams Commented Feb 11 at 17:14
• There is one workbook with two sheets, one called NISR and one called FORM. The button 'Generate NISRs' creates the additional sheets. The code runs on the "FORM" sheet. The NISR sheet has no code, it's only used to be copied+pasted. – Darian Marino Commented Feb 11 at 17:25
• If you're adding the code after the "y = y+1", then the error message makes sense. Since y is the number of sheets in your workbook, then adding 1 to it will result in a sheet count that is greater than the number of sheets your workbook has, thus giving you the "subscript out of range" message. – Frank Ball Commented Feb 11 at 17:27

Add a comment  | 

1 Answer 1

Sorted by: Reset to default 0

Try this out - see notes in comments

Private Sub CommandButton1_Click()

    Dim x As Long, y As Long, wsNew As Worksheet, wb As Workbook, mmr
    
    Set wb = ThisWorkbook 'always best to use an explicit workbook
    
    x = 8
    
    'in a sheet code module, you can use `Me` to refer to the sheet
    Do Until Me.Range("B" & x).Value = ""
    
        'get a reference to the newly-added sheet
        Set wsNew = wb.sheets.Add(After:=wb.Worksheets(wb.Worksheets.count))
        wb.Worksheets("NISR").Cells.Copy wsNew.Range("A1") 'no activate required...
    
        'Recommend avoiding "single-use" variables: you can use comments to clarify
        '   what is being transferred...
        wsNew.Range("B29") = Me.Range("D2").Value  'ReqName
        wsNew.Range("M29") = Me.Range("D3").Value  'ReqT
        wsNew.Range("R29") = Me.Range("G2").Value  'Dept
        wsNew.Range("AA29") = Me.Range("G3").Value 'currDate
    
        mmr = Me.Range("G" & x).Value
        'if there's an mmr, use that, or use the sheet count
        wsNew.Name = IIf(Len(mmr) > 0, mmr, wb.Worksheets.count)
        x = x + 1
    Loop
    
    wb.Worksheets(1).Activate

End Sub

You might want to add a check to make sure you're not trying to name the new worksheet the same as an existing worksheet (in case of duplicate values in ColG for example)

本文标签： excelCopyPaste a sheet in VBA and rename is based on whether a cell is blank or notStack Overflow