简体   繁体   中英

Looping for N Number of Sheets - Excel VBA

I have a template sheet. Then depending on the input on another sheet, template sheet will be copied N times and renamed as N. What I want to do now is to create a loop to transfer data from the sheets to a destination.

So example, from the Start sheet, (where the number input will come from), let's say I typed 5 since I want to have 5 sheets from the template. This will be renamed as 1...2...3...4...5.

And then, afterwards, once I've used these numbered sheets, I want to copy the data from these sheet to destination sheet. How do I do that?

In hand, I have the code for duplication and renaming of the worksheets and the following codes.

PS. How do I simplify the insert N cells to the left? Thank you so much. :)

    Sub CreateLoaderBeta1()

        Dim origin      As Worksheet
        Dim destination As Worksheet
        Dim desrow      As Long
        Dim descol      As Long
        Dim descolstart As Long
        Dim origrow     As Long
        Dim origcol     As Long
        Dim rang        As Range
        Dim C           As Range
        Dim qual        As Integer

        Set origin = Sheets("1")
        Set destination = Sheets("OFFLIMITS")
        desrow = 1
        descol = 1
        origrow = 18
        origcol = 32
        Set rng = origin.Range("AF18:af47")
        total = WorksheetFunction.SUM(origin.Range("AF18:AF47"))
        descolstart = destination.cells(desrow, Columns.Count).End(xlToLeft).column
        descolnext = descolstart + 1

        If total > 0 Then

                For Each C In rng
                    If C = 14 Then

                    'No,Type,Amount,Distribution Account,Description,Product Type,VAT,Ewt,Net Purchases,Yes/No,Enter

                            destination.cells(desrow, descolstart).Value = origin.cells(origrow, 1).Value 'to copy sequence number
                            destination.cells(desrow, descolstart + 1).Value = "\{TAB}" 'to insert tab
                            destination.cells(desrow, descolstart + 2).Value = origin.cells(origrow, 4).Value 'type
                            destination.cells(desrow, descolstart + 3).Value = "\{TAB}" 'to insert tab
                            destination.cells(desrow, descolstart + 4).Value = origin.cells(origrow, 27).Value 'amount
                            destination.cells(desrow, descolstart + 5).Value = "\{TAB}" 'to insert tab
                            destination.cells(desrow, descolstart + 6).Value = origin.cells(origrow, 6).Value 'distribution account
                            destination.cells(desrow, descolstart + 7).Value = "\{TAB}" 'to insert tab
                            destination.cells(desrow, descolstart + 8).Value = origin.cells(origrow, 30).Value 'description
                            destination.cells(desrow, descolstart + 9).Value = "\{TAB}" 'to insert tab
                            destination.cells(desrow, descolstart + 10).Value = origin.cells(origrow, 9).Value 'product type
                            destination.cells(desrow, descolstart + 11).Value = "\{TAB}" 'to insert tab
                            destination.cells(desrow, descolstart + 12).Value = origin.cells(origrow, 10).Value 'VAT
                            destination.cells(desrow, descolstart + 13).Value = "\{TAB}" 'to insert tab
                            destination.cells(desrow, descolstart + 14).Value = origin.cells(origrow, 11).Value 'wht
                            destination.cells(desrow, descolstart + 15).Value = "\{TAB}" 'to insert tab
                            destination.cells(desrow, descolstart + 16).Value = "\{TAB}" 'to insert tab
                            destination.cells(desrow, descolstart + 17).Value = "Net Purchases" 'to Net Purchases
                            destination.cells(desrow, descolstart + 18).Value = "\{TAB}" 'to insert tab
                            destination.cells(desrow, descolstart + 19).Value = origin.cells(origrow, 13).Value 'wht
                            destination.cells(desrow, descolstart + 20).Value = "\{TAB}" 'to insert tab
                            destination.cells(desrow, descolstart + 21).Value = "\{ENTER}" 'to insert tab
                            destination.cells(desrow, descolstart + 22).Value = "\{DOWN}" 'to insert tab

                            descolstart = descolstart + 23
                            origrow = origrow + 1

                    End If
                Next C

                destination.cells(desrow, 1).insert Shift:=xlToRight
                destination.cells(desrow, 1).insert Shift:=xlToRight
                destination.cells(desrow, 1).insert Shift:=xlToRight
                destination.cells(desrow, 1).insert Shift:=xlToRight
                destination.cells(desrow, 1).insert Shift:=xlToRight
                destination.cells(desrow, 1).insert Shift:=xlToRight
                destination.cells(desrow, 1).insert Shift:=xlToRight
                destination.cells(desrow, 1).insert Shift:=xlToRight
                destination.cells(desrow, 1).insert Shift:=xlToRight
                destination.cells(desrow, 1).insert Shift:=xlToRight
                destination.cells(desrow, 1).insert Shift:=xlToRight
                destination.cells(desrow, 1).insert Shift:=xlToRight
                destination.cells(desrow, 1).insert Shift:=xlToRight
                destination.cells(desrow, 1).insert Shift:=xlToRight
                destination.cells(desrow, 1).insert Shift:=xlToRight
                destination.cells(desrow, 1).insert Shift:=xlToRight
                destination.cells(desrow, 1).insert Shift:=xlToRight
                destination.cells(desrow, 1).insert Shift:=xlToRight
                destination.cells(desrow, 1).insert Shift:=xlToRight
                destination.cells(desrow, 1).insert Shift:=xlToRight
                destination.cells(desrow, 1).insert Shift:=xlToRight
                destination.cells(desrow, destination.cells(desrow, Columns.Count).End(xlToLeft).column).Value = "\%C"
                destination.cells(desrow, destination.cells(desrow, Columns.Count).End(xlToLeft).column + 1).Value = "\%V"
                destination.cells(desrow, destination.cells(desrow, Columns.Count).End(xlToLeft).column + 1).Value = "\%K"

                'Call headers

                        Dim originWS    As Worksheet
                        Dim desWS       As Worksheet
                        Dim rowNO       As Integer

                        Set originWS = origin 'CHANGE THIS TO SHEET NUMBER
                        Set desWS = destination
                        rowNO = desrow

                        desWS.Range("A" & rowNO).Value = originWS.Range("C1").Value
                        desWS.Range("c" & rowNO).Value = originWS.Range("C2").Value
                        desWS.Range("e" & rowNO).Value = Worksheets("Start").Range("C22").Value
                        desWS.Range("H" & rowNO).Value = originWS.Range("C3").Value
                        desWS.Range("J" & rowNO).Value = originWS.Range("C4").Value
                        desWS.Range("L" & rowNO).Value = originWS.Range("C4").Value
                        desWS.Range("N" & rowNO).Value = originWS.Range("C5").Value
                        desWS.Range("P" & rowNO).Value = originWS.Range("C6").Value
                        desWS.Range("R" & rowNO).Value = originWS.Range("C7").Value
                        desWS.Range("T" & rowNO).Value = originWS.Range("C8").Value

                        'to insert the keystrokes
                        desWS.Range("B" & rowNO).Value = "\{TAB}"
                        desWS.Range("D" & rowNO).Value = "\{TAB}"
                        desWS.Range("F" & rowNO).Value = "\{TAB}"
                        desWS.Range("G" & rowNO).Value = "\{TAB}"
                        desWS.Range("I" & rowNO).Value = "\{TAB}"
                        desWS.Range("K" & rowNO).Value = "\{TAB}"
                        desWS.Range("M" & rowNO).Value = "\{TAB}"
                        desWS.Range("O" & rowNO).Value = "\{TAB}"
                        desWS.Range("Q" & rowNO).Value = "\{TAB}"
                        desWS.Range("S" & rowNO).Value = "\{TAB}"
                        desWS.Range("U" & rowNO).Value = "\%2"

                destination.Columns("J:J").NumberFormat = "dd-mmm-yy"
                destination.Columns("L:L").NumberFormat = "dd-mmm-yy"

        Else 'Do nothing

        End If

        End Sub

This question is actually threefold. The first part: Get n sheets generated with name "1", "2", etc. up to "n". Let us say that in Worksheet("Sheet1") in Range A1 you set the number of sheets you wish to generate. The script would then be:

Sub GenerateSheets()
Dim i as Integer
Dim numberOfSheets as Integer
Dim ws as Worksheet

numberOfSheets = Worksheets("Sheet1").Range("A1").value

For i = 1 to numberOfSheets
    Set ws = Worksheets.add()
    With ws
        .name = i
        'Do other stuff with the new sheet
    End With
Next i
End Sub

If these new sheets need to be copies of a template sheet, you could do:

Sub GenerateSheets()
Dim i As Integer
Dim numberOfSheets As Integer
Dim ws As Worksheet

numberOfSheets = Worksheets("Sheet1").Range("A1").Value

For i = 1 To numberOfSheets
    Worksheets("Template").Copy After:=Worksheets("Template")
    Set ws = Worksheets(Worksheets("Template").Index + 1)
    With ws
        .Name = i
        'Do other stuff with the new sheet
    End With
Next i
End Sub

The second question is: How do I get data from this worksheet back to my destination sheet? You could either just set values in "Destination" to be equal to values in your worksheet, or copy the entire cells. Based on your sample script, I'd say the first one has preference. Let's say that you wish to copy the value from Range A1 in the new sheet to Range A1 in the destination. You can then amend the above as follows:

Sub GenerateSheets()
Dim i as Integer
Dim numberOfSheets as Integer
Dim ws as Worksheet
Dim destination as Worksheet

numberOfSheets = Worksheets("Sheet1").Range("A1").value

Set destination = Worksheets("Destination")

For i = 1 to numberOfSheets
    Set ws = Worksheets.add()
    With ws
        .name = i
        .Range("A1") = "Some value"
        destination.Range("A1").value = .Range("A1").value ' = "Some value"
        'Do other stuff with the new sheet
    End With
Next i
End Sub

The third part of the question: "How do I simplify the insert N cells to the left?" This depends on how many cells you wish to insert, but let's say it's X cells, the simplest way based on your existing code would be to resize the range to insert:

destination.cells(desrow, 1).Resize(1, X).insert Shift:=xlToRight

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM