In need a VBA script to create sheets from 3 different template sheets and more...

vlacombe

New Member
Joined
Oct 4, 2019
Messages
29
Hi Peter, your suggestion works for the merged cell issue, thank you very much for that!

Let me try to explain the previous problem again, and please know that I appreciate the patiente your taking with me given my english and my low level of understanding of VBA coding in excel
The range of the cells that are being copied, given the latest script suggestion, works perfectly but ONLY for Temp1
Temp2 and Temp3 will get the same value but it needs to be copied onto different cells (or range)

For instance, without writing down the full list of cell range being copied... This works fine with temp1 (that will be created into Type1-xxx sheet):

.Range("C9:C14").Value = wsM.Range("C3:C8").Value
.Range("H9:H14").Value = wsM.Range("H3:H8").Value
But Temp2 and Temp3 are slightly different (Visually the overall look of the sheet is similar, and serves me the same BUT the equivalent of C9:C14 and H9:H14 needs to go somewhere else
I would need something like this for Temp2, and then something different for Temp3 as well:

.Range("D10:D15").Value = wsM.Range("C3:C8").Value
.Range("I10:I15").Value = wsM.Range("H3:H8").Value

So basically, all the cell values copied from the Master sheet will get to each different type of sheets(Type1 for temp1, Type2 for temp2, Type3 for temp3) but for every single type, the cells or ranges it needs to be copied to are different from each other Type



Now it would be easy for me to modify the script myself to fix the destination cells it needs to be copied to for every "type" sheets, hence why I prefer to keep this post as clean as I can and not have to write down all the "copy to" ranges for each temp/Type sheets

I just need a little bit of help to insert the logic into the script that says:

If it's a Type1 sheet, then copy Cell A (from master) to Cell B (of Type1)
Then Cell A (from master) to Cell F (of Type2)
and finaly Cell A (from master) to Cell X (of Type3)

And then I'll fix the cells/ranges myself

Hopefully you have a better understanding of the issue
Thank you for your time
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
41,739
Office Version
365
Platform
Windows
I would need something like this for Temp2, ...:

.Range("D10:D15").Value = wsM.Range("C3:C8").Value
.Range("I10:I15").Value = wsM.Range("H3:H8").Value
Just so I can try to get things clear in my head, does that mean the following statement that you made earlier is in fact incorrect?

Here is the merged cells list that are being copied over or onto

On all 3 templates:
C9 to C14 are merged 2 cells wide horitontaly, so C9 is actually C9:D9 ...
.. and it follows that C10 is actually C10:D10
 

vlacombe

New Member
Joined
Oct 4, 2019
Messages
29
Hi Peter,

Again thank you for your patiente and perseverance with me :)

Maybe this will help you understand better

For Temp1 (when we paste data from Master to Type1 created from Temp1) I need:

.Range("C9:C14").Value = wsM.Range("C3:C8").Value
.Range("H9:H14").Value = wsM.Range("H3:H8").Value
.Range("B23").Value = wsM.Range("J11").Value
.Range("B29:B30").Value = wsM.Range("J12:J13").Value
.Range("B32").Value = wsM.Range("J14").Value
.Range("I28").Value = wsM.Range("J15").Value

For Temp2 (when we paste data from Master to Type2 created from Temp2) I need:

.Range("C9:C14").Value = wsM.Range("C3:C8").Value
.Range("H9:H14").Value = wsM.Range("H3:H8").Value
.Range("B23").Value = wsM.Range("J11").Value
.Range("B29").Value = wsM.Range("J12").Value
.Range("B31").Value = wsM.Range("J13").Value

.Range("B36").Value = wsM.Range("J14").Value
.Range("I33").Value = wsM.Range("J15").Value


For Temp3 (when we paste data from Master to Type3 created from Temp3) I need:


.Range("C9:C14").Value = wsM.Range("C3:C8").Value
.Range("H9:H14").Value = wsM.Range("H3:H8").Value
.Range("B23").Value = wsM.Range("J11").Value
.Range("B30").Value = wsM.Range("J13").Value
.Range("B35").Value = wsM.Range("J14").Value
.Range("I32").Value = wsM.Range("J15").Value


I have highlighted the slight difference exactly as I need. As mentionned above in previous replies. I need all the exact same data from my master sheet to go to all Type1 2 and 3 created... although some of those values will be copied on different cells depending what Type# it is

I can play with the cells range myself if needs be or if I move things around. I only need the logic in the script that copies the right value to the right cells depending on what Type# it's creating. As mentionned on my first post: Type1 will be created if there a value greater than 0 in cells C12:C15, Type2 will be created if there a value greater than 0 in cells D12:D15 and finaly Type3 will be created if there a value greater than 0 in cells E12:E15

If I take only a part of the latest script you suggested, I would assume it should look something like this... (although I'm not sure of the syntax and "End If" position...)

With Sheets(Sheets.Count)
IF c = 1
.Name = sName
.Range("C9:C14").Value = wsM.Range("C3:C8").Value
.Range("H9:H14").Value = wsM.Range("H3:H8").Value
.Range("B23").Value = wsM.Range("J11").Value
.Range("B29:B30").Value = wsM.Range("J12:J13").Value
.Range("B32").Value = wsM.Range("J14").Value
.Range("I28").Value = wsM.Range("J15").Value
END IF
IF c = 2

.Name = sName
.Range("C9:C14").Value = wsM.Range("C3:C8").Value.Range("H9:H14").Value = wsM.Range("H3:H8").Value
.Range("B23").Value = wsM.Range("J11").Value
.Range("B29").Value = wsM.Range("J12").Value
.Range("B31").Value = wsM.Range("J13").Value

.Range("B36").Value = wsM.Range("J14").Value
.Range("I33").Value = wsM.Range("J15").Value
END IF
IF c = 3

.Name = sName
.Range("C9:C14").Value = wsM.Range("C3:C8").Value
.Range("H9:H14").Value = wsM.Range("H3:H8").Value
.Range("B23").Value = wsM.Range("J11").Value
.Range("B30").Value = wsM.Range("J13").Value
.Range("B35").Value = wsM.Range("J14").Value
.Range("I32").Value = wsM.Range("J15").Value
END IF



End With

Does this help you understand?
Thank you
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
41,739
Office Version
365
Platform
Windows
[/B]I have highlighted the slight difference exactly as I need. As mentionned above in previous replies. I need all the exact same data from my master sheet to go to all Type1 2 and 3 created... although some of those values will be copied on different cells depending what Type# it is
Sorry, again I need to check as those 2 statements don't agree. From the information you gave above this quote J12 from Master is copied to Type1 and Type2 sheets but not to Type3 sheets.

Never-the-less it is apparent that there is no pattern about what goes where in relation to Master J12:J15 so I think we will need to specify for each sheet and you should be able to modify this to resolve the J12 to Type3 issue if required.
The TMap lines list the pairs of cells that need to be related. The first of each pair is the TypeX cell address and the second of each pair is the corresponding Master cell address. (We don't need to list the ones that go to the same cells on each Type sheet.)

Rich (BB code):
Sub Create_Sheets_v4()
  Dim d As Object, AL As Object
  Dim wsM As Worksheet, ws As Worksheet
  Dim itm As Variant
  Dim TMap(1 To 3) As String
  Dim rngTemplateNumbers As Range
  Dim r As Long, c As Long, i As Long
  Dim sName As String
  Dim bSheetAdded As Boolean
  
  TMap(1) = "B29,J12,B30,J13,B32,J14,I28,J15"
  TMap(2) = "B29,J12,B31,J13,B36,J14,I33,J15"
  TMap(3) = "B30,J13,B35,J14,I32,J15"
  
  Set d = CreateObject("Scripting.Dictionary")
  Set wsM = Sheets("Master")
  Application.ScreenUpdating = False
  With wsM
    Set rngTemplateNumbers = .Range("C12:E15")
    With rngTemplateNumbers
      For c = 1 To .Columns.Count
        For r = 1 To .Rows.Count
          If Len(.Cells(r, c).Value) > 0 Then
            sName = "Type" & c & "-" & .Cells(r, c).Value
            d(sName) = d(sName) + 1
            If d(sName) > 1 Then sName = sName & -d(sName)
            Set ws = Nothing
            On Error Resume Next
            Set ws = Sheets(sName)
            On Error GoTo 0
            If ws Is Nothing Then
              Sheets("Temp" & c).Copy After:=Sheets(Sheets.Count)
              bSheetAdded = True
              With Sheets(Sheets.Count)
                .Name = sName
                .Range("C9:C14").Value = wsM.Range("C3:C8").Value
                .Range("H9:H14").Value = wsM.Range("H3:H8").Value
                wsM.Range("J11").Copy Destination:=.Range("B23")
                itm = Split(TMap(c), ",")
                For i = 0 To UBound(itm) Step 2
                  .Range(itm(i)).Value = wsM.Range(itm(i + 1)).Value
                Next i
              End With
            End If
          End If
        Next r
      Next c
    End With
  End With
  If bSheetAdded Then
    Set AL = CreateObject("System.Collections.ArrayList")
    For Each ws In Worksheets
      If ws.Name Like "Type*" Then AL.Add ws.Name
    Next ws
    AL.Sort
    For Each itm In AL
      Sheets(itm).Move After:=Sheets(Sheets.Count)
    Next itm
  End If
  Application.ScreenUpdating = True
End Sub
 

vlacombe

New Member
Joined
Oct 4, 2019
Messages
29
Hi Peter, perhaps it is my english, I'm sorry for that
Thanks for the suggestion, I should be able to test it tomorrow or after tomorrow
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
41,739
Office Version
365
Platform
Windows
Hi Peter, perhaps it is my english, I'm sorry for that
Thanks for the suggestion, I should be able to test it tomorrow or after tomorrow
OK, I look forward to hearing how you go.
I'm sure we will get it sorted out in the end. :)
 

vlacombe

New Member
Joined
Oct 4, 2019
Messages
29
Hi Peter

That about sums it up! :)
It does everything I need the way I want it now

I did modify the script a tiny bit to include a few things that I was able to do on my own from my learning experience since I've been here on this forum

Thank you very much for your help.
You are quite a knowledgable person when it comes to VBA and you have been extremely patient!

Best regards
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
41,739
Office Version
365
Platform
Windows
You're welcome, and thanks for your kind words. :)
 

Forum statistics

Threads
1,077,849
Messages
5,336,734
Members
399,100
Latest member
darcob

Some videos you may like

This Week's Hot Topics

Top