Nシートのループ - Excel VBA

Question

私はテンプレートシートを持っています。次に、別のシートの入力に応じて、テンプレートシートがN回コピーされ、Nという名前に変更されます。ここでは、シートから送り先にデータを転送するループを作成します。

例として、スタートシートから（数字入力が来るところ）、テンプレートから5枚のシートが必要なので5とタイプしましょう。これは、1 ... 2 ... 3 ... 4 ... 5と変更されます。

その後、これらの番号の付いたシートを使用したら、これらのシートから目的のシートにデータをコピーしたいと思います。それ、どうやったら出来るの？

私は、ワークシートと次のコードを複製して名前を変更するコードを用意しています。

PS。どのようにして左側の挿入N細胞を単純化するのですか？どうもありがとうございます。 :)

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 

Answer 1

この質問は実際には3倍です。最初の部分： "n"まで名前 "1"、 "2"などで生成されたn枚のシートを取得します。範囲A1のワークシート（ "Sheet1"）で、生成するシートの枚数を設定するとします。スクリプトは次のようになります。

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 

これらの新しいシートはテンプレートシートのコピーする必要がある場合は、あなたができる：

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 

2番目の質問です：どのように私はこのワークシートからデータを取得します私の目的地のシートに戻って？ 「宛先」の値をワークシートの値と同じに設定するか、セル全体をコピーするかのいずれかです。あなたのサンプルスクリプトに基づいて、私は最初のものが好みを持っていると言うでしょう。 新しいシートの範囲A1の値を宛先の範囲A1にコピーしたいとします。

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 

の質問の第三部：次のようにその後、上記を修正することができます「？どのように私は左の挿入N細胞を簡素化します」 これは、挿入したいどのように多くの細胞に依存しますが、のは、それがX細胞だとしましょう、あなたの既存のコードに基づいて、最も簡単な方法は、挿入する範囲のサイズを変更するには、次のようになります。

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