VBA Copy & Paste tab based on criteria

[SDMaestro]

Hi All,

I have spreadsheet I am working on that I know could benefit from a Macro, but my VBA experience is minimal so I'm having difficulty wrapping my head around how to write it.

Currently I have two worksheets (1 Master & a template that feeds off of it), the structure of the master tab is below

Co.	Div.	PC.	GL	Name	Balance	Rec Required (Actually in Column L)
6	539	0	1102	AR	100	Yes
6	539	0	1102	PPD	100	No

<tbody>
</tbody>

What I would like to do is three fold

1. have a copy of my worksheet "Template" made for any record labeled "yes" under Rec Required
2. Populate that records Co./Div./PC./GL/ into C3/C4/C5/C6 of the newly pasted template
3. Rename the the newly pasted tab as that records Co.-Div.-PC.-GL (6-539-0-1102)

Any help with writing this macro is greatly appreciated

 

[vcoolio]

Hello SDMaestro,

Try the following code placed in the Master sheet module:-

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)

      Dim sh As Worksheet: Set wsM = Sheets("Master")
      Dim wsT As Worksheet: Set wsT = Sheets("Template")
      
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
If Intersect(Target, Range("L3:L" & Rows.Count)) Is Nothing Then Exit Sub

If Target.Value = "Yes" Then
wsT.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

With Sheets(ThisWorkbook.Sheets.Count)
       .Name = Target.Offset(, -9) & "-" & Target.Offset(, -8) &  "-" & Target.Offset(, -7) & "-" & Target.Offset(, -6) &  "-" & Target.Offset(, -5)
      End With
End If

With wsM
      .Range(.Cells(Target.Row, "C"), .Cells(Target.Row, "L")).Copy ActiveSheet.Range("C" & Rows.Count).End(3)(2)
End With

MsgBox "A new sheet is ready!", vbExclamation
ActiveSheet.Select

End Sub

The code is a WorkSheet_Change event and needs to be placed in the Master sheet module. Every time that you type "Yes" in any cell in Column L the code will execute and do its thing.

To implement this code:-

- Right click on the Master sheet tab.
- Select "View Code" from the menu that appears.
- In the big white field that then appears, paste the above code.



I've attached a little sample at the following link for you to see if we are at least close to the end result:-

http://ge.tt/2OjTs2p2

In the sample, just overwrite the "Yes" (or "No") values then click away (or press enter or down arrow) to execute the code.

I hope that this helps.

Cheerio,
vcoolio.

 

[vcoolio]

Hi SD Maestro,

Just picked up on a typo. In the above code, alter this line:-

      Dim sh As Worksheet: Set wsM = Sheets("Master")

to

 Dim wsM As Worksheet: Set wsM = Sheets("Master")

Cheerio,
vcoolio.

 

[SDMaestro]

Hi vcoolio,

This is awesome ! And very close to what I am looking for. I could potentially reverse engineer it from here but is it possible to revise the macro so that it is assigned to a shape ? The yes/no in Column L is based on a formula so ideally a user would finish the master sheet & have say 10 records with yes, push the button & the macro creates 10 named templates.

It might be easier with a copy of the workbook
http://ge.tt/7xB7F3p2

Much thanks for your input.

 

[Fluff]

How about

Sub CreateTemplate()
   Dim Ws As Worksheet
   Dim Cl As Range
   
   Set Ws = ActiveSheet
   For Each Cl In Ws.Range("L3", Ws.Range("L" & Rows.Count).End(xlUp))
      If LCase(Cl.Value) = "yes" Then
         Sheets("Template").Copy After:=Sheets(Sheets.Count)
         ActiveSheet.Range("C3:C6").Value = Application.Transpose(Cl.Offset(, -11).Resize(, 4))
         ActiveSheet.Name = Join(Application.Transpose(Range("C3:C6")), " - ")
      End If
   Next Cl
   Ws.Select
End Sub

 

[SDMaestro]

Wow, Thank you Fluff ! Works like a charm.

 

[Fluff]

Glad to help & thanks for the feedback

 

[vcoolio]

Hello SDMaestro,

Looks like our Lancastrian friend has done the deed for us.

Apologies also for not properly reading your opening post as you wanted the data transposed to the vertical in the new sheets (C3:C6).

Thanks for the feedback.

Cheerio,
vcoolio.

 

[Dryver14]

Has Chippenham moved??

 

[vcoolio]

Oops! My batting average is zero in relation to this thread so far!

I was only about 400-500Km off target!