Excel 复制模板并填写另一工作表中的值

我现在正在尝试创建多个工作表，并将数据从现有工作表复制到我刚刚创建的工作表中

这就是我迄今为止所尝试的：

Sub CreateTemplate()

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "CUST001"
Worksheets("Template").Cells.Copy Worksheets("CUST001").Cells
Worksheets("CUST001").Select
Range("C4") = "='CDE Information'!R[-2]C[-2]"
Range("C5") = "='CDE Information'!R[-3]C[-1]"
Range("C6") = "1111"
Range("C7") = "2222"

End Sub

这是我要复制的表的一个示例。

我还想创建工作表，并根据A列中每行的值命名它们

所以，在我看来，我应该对循环做些什么，但我对此一无所知。

---

有人能帮我吗？提前谢谢你

欢迎来到stack。试试这个：

Option Explicit
Sub copyWs()
    Dim arr, j As Long
    With Sheet1
        arr = .Range("A1").CurrentRegion.Value2 'get all data in memory
        For j = 1 To UBound(arr) 'traverse rows
            .Copy After:=ActiveWorkbook.Sheets(Worksheets.Count) 'add ws after the last ws
            Sheets(ActiveWorkbook.Sheets(Worksheets.Count).Index).Name = arr(j, 1) 'name the last added ws
        Next j
    End With
End Sub

现在我们已经有了一个包含所有数据的数组，我们也可以只将部分数据复制到新的工作表，而不是复制整个工作表。为了实现这一点，我们将首先创建一张空白表：

Sheets.Add After:=ActiveWorkbook.Sheets(Worksheets.Count) 'add ws after the last ws

迭代数组时，我们将使用2个“计数器”变量。1穿过线条，1穿过柱子

Dim j As Long, i As Long 'initiate our counter vars
For j = 1 To UBound(arr) 'traverse rows
    For i = 1 To UBound(arr, 2) 'traverse columns
        'here we can access each cell by referencing our array(<rowCounter>, <columnCounter>
        'e.g. arr(j,i) => if j = 1 and i = 1 we'll have the values of Cell A1
    Next i
Next j

Dim j只要，我只要“启动我们的计数器变量”
对于j=1到UBound（arr）'遍历行
对于i=1到UBound（arr，2）“遍历列
'在这里，我们可以通过引用数组（，
例如，arr（j，i）=>如果j=1，i=1，我们将得到单元格A1的值
接下来我
下一个j

“Ubound”函数允许我们获得行和列的总nr

Dim arr2
ReDim arr2(1 To 1, 1 To UBound(arr)) '=> we only need 1 line but all columns of the source, as we cannot dynamically size an array with the "dim", we redim
For j = 1 To UBound(arr) 'traverse rows
    For i = 1 To UBound(arr, 2) 'traverse columns
        'here we can access each cell by referencing our array(<rowCounter>, <columnCounter>
        'e.g. arr(j,i) => if j = 1 and i = 1 we'll have the values of Cell A1
        'we can dump these values anywhere in the activesheet, other sheet, other workbook, .. but to limit the number of interactions with our sheet object we can also create new, intermediant arrays
        'e.g. we could now copy cel by cel to the new sheet => Sheets(arr(j,1).Range(... but this would create significant overhead
        'so we'll use an intermediant array to store the full line

        arr2(1, i) = arr(j, i)
    Next i
        'when we have all the columns we dumb to the sheet
        With Sheets(arr(j, 1)) 'the with allows us the re-use the sheet name without typing it again
            .Range(.Cells(1, 1), .Cells(UBound(arr2), UBound(arr2, 2))).Value2 = arr2 'the ubound function allows us to size the "range" to the same size as our array, once that's done we can just dumb it to the sheet
        End With
Next j

Dim arr2
ReDim arr2（1到1，1到UBound（arr））=>我们只需要一行，但需要源的所有列，因为我们不能用“dim”动态调整数组的大小，所以我们需要ReDim
对于j=1到UBound（arr）'遍历行
对于i=1到UBound（arr，2）“遍历列
'在这里，我们可以通过引用数组（，
例如，arr（j，i）=>如果j=1，i=1，我们将得到单元格A1的值
'我们可以将这些值转储到activesheet、其他工作表、其他工作簿中的任何位置，…但为了限制与工作表对象的交互次数，我们还可以创建新的中间数组
例如，我们现在可以将cel逐个cel复制到新的sheet=>Sheets（arr（j，1）.Range）（…但这会产生很大的开销
'因此，我们将使用中间数组来存储完整的行
arr2（1，i）=arr（j，i）
接下来我
“当我们有了所有的专栏之后，我们就对这张纸哑口无言了
With Sheets（arr（j，1））'With允许我们重复使用图纸名称，而无需再次键入
.Range（.Cells（1，1），.Cells（UBound（arr2），UBound（arr2，2）））.Value2=arr2'UBound函数允许我们将“Range”的大小调整为与数组相同的大小，一旦完成，我们就可以将其哑到工作表中
以
下一个j

非常感谢您的贡献Ceci！非常感谢您的贡献，@Ceci！但是，我还想请VBA将另一个工作表中的表（我们称之为表1）中的信息复制到新创建的工作表（我们称之为工作表a）。例如，表1的第一行将打印在工作表A上。之后，我想请VBA创建一个新工作表（工作表B）并将表1的第二行复制到工作表B。循环将重复，直到它为表1中的所有行创建了工作表。添加了您需要的信息。尝试将其合并，并让我知道它是如何进行的：）非常感谢Ceci！