循环N张表格 – Excel VBA
我有一个模板表。 然后，根据另一个工作表上的input，模板工作表将被复制N次，并重新命名为N.现在我想要做的是创build一个循环来将工作表中的数据传输到目标。
因此，例如，从“开始”工作表（其中input的数字来自哪里），假设我input了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 这个问题实际上是三重的。 第一部分：用名称“1”，“2”等生成n张表，直到“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
第二个问题是：如何从此工作表中获取数据返回到目标工作表？ 您可以将“目标”中的值设置为等于工作表中的值，也可以复制整个单元格。 根据您的示例脚本，我会说第一个有偏好。 假设您希望将新工作表中范围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单元到左边？ 这取决于你希望插入多less个单元格，但是假设它是X单元格，基于现有代码的最简单的方法是调整要插入的范围：
destination.cells(desrow, 1).Resize(1, X).insert Shift:=xlToRight