Question

我有一个Excel标记，列出了我的所有学生，并且我使用VBA自动命名并将A列中的每个单元格超链接到一个新工作表，其中包含每个子项的摘要，使用模板表作为模式为了这。

Sub AutoAddSheet()

Dim MyCell As Range, MyRange As Range

Set MyRange = Sheets("DATA ENTRY").Range("A4")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

Application.ScreenUpdating = False

For Each MyCell In MyRange
Sheets("Template").Copy After:=Sheets(Sheets.Count)

 With Sheets(Sheets.Count)
   .Name = MyCell.Value
   .Cells(2, 1) = MyCell.Value

End With

MyCell.Hyperlinks.Add Anchor:=MyCell, Address:="", SubAddress:="'" & MyCell.Value & "'!A1"

Next MyCell
Application.ScreenUpdating = True

End Sub

我不知道如何编写代码以允许每个新工作表也有一个超链接回原始数据表，所以只需将其放在模板表上即可。

我真正想要做的是能够从DATA ENTRY表中提取某些数据，并将它们放在相关的工作表上，其中格式不会因每个孩子而改变 - 只是信息。例如，子1的名称在B4中，但是在子项1的工作表上的C2中，目标等级在DATA ENTRY的E4中，但在他们的个人表上的E5中。子项2的名称在B5中，目标等级为E5，但C2和E5分别用于子项2的工作表。子项3 = B6，依此类推。

我从一张非常大的原始图纸中获得十条独立的信息，这些信息需要放在与每个孩子相关的单独工作表上。有没有办法做到这一点，还是我手动必须通过并将子1工作表中的C2单元格链接回DATA ENTRY的B4单元格？我有大约200个工作表要经历，所以我希望前者！

我现在有以下代码，但它只填写第一张表，而不是为我循环并填写其他表格：

Private Sub Setup_Sheets()
Dim Data_Entry As Worksheet          'You don't need variables. You can use Sheet1 and Sheet2 directly.
Set Data_Entry = Sheet1
Dim child1_sheet As Worksheet
Set child1_sheet = Sheet44            'Repeat for each child(sheet number is unqiue to your workbook)
Dim NameRange As Range
Set NameRange = Data_Entry.Range("B4")
child1_sheet.Range("C2").Value = NameRange.Value

Set NameRange = Data_Entry.Range("C4")
child1_sheet.Range("C3").Value = NameRange.Value

Set NameRange = Data_Entry.Range("D4")
child1_sheet.Range("C4").Value = NameRange.Value

Set NameRange = Data_Entry.Range("E4")
child1_sheet.Range("E5").Value = NameRange.Value

Set NameRange = Data_Entry.Range("G4")
child1_sheet.Range("G5").Value = NameRange.Value

Set NameRange = Data_Entry.Range("S4")
child1_sheet.Range("C9").Value = NameRange.Value

Set NameRange = Data_Entry.Range("AE4")
child1_sheet.Range("C10").Value = NameRange.Value

Set NameRange = Data_Entry.Range("AQ4")
child1_sheet.Range("C11").Value = NameRange.Value

Set NameRange = Data_Entry.Range("BC4")
child1_sheet.Range("C12").Value = NameRange.Value

Set NameRange = Data_Entry.Range("BE4")
child1_sheet.Range("F5").Value = NameRange.Value

End Sub

我也尝试过以下内容，但是这会将每张单页填充第一个孩子的数据。有谁知道我做错了什么？

Private Sub Setup_with_loop()
Dim child_cnt As Integer
child_cnt = ThisWorkbook.Worksheets.Count
For i = 2 To child_cnt                      'Assuming the first sheet is the data entry sheet
    ThisWorkbook.Worksheets(i).Range("C2").Value = Sheet1.Range("B4").Value  
    ThisWorkbook.Worksheets(i).Range("C3").Value = Sheet1.Range("D4").Value  
    ThisWorkbook.Worksheets(i).Range("C4").Value = Sheet1.Range("F4").Value  
    ThisWorkbook.Worksheets(i).Range("E5").Value = Sheet1.Range("G4").Value
    ThisWorkbook.Worksheets(i).Range("G5").Value = Sheet1.Range("I4").Value 
    ThisWorkbook.Worksheets(i).Range("C9").Value = Sheet1.Range("U4").Value     
    ThisWorkbook.Worksheets(i).Range("C10").Value = Sheet1.Range("AG4").Value 
    ThisWorkbook.Worksheets(i).Range("C11").Value = Sheet1.Range("AS4").Value   
    ThisWorkbook.Worksheets(i).Range("C12").Value = Sheet1.Range("BE4").Value 
    ThisWorkbook.Worksheets(i).Range("F5").Value = Sheet1.Range("BG4").Value   
Next
End Sub

Answer 1

您不必手动浏览并链接每个单元格。您只需使用以下代码运行循环即可。显然，您需要为每个数据添加一行，但下面的概念应该足以让您前进。我不得不问。你有200个孩子的200张工作表吗？或200个工作簿，每个说10个孩子？

Private Sub Setup_with_loop()
Dim child_cnt As Integer
child_cnt = ThisWorkbook.Worksheets.Count
For i = 2 To child_cnt                      'Assuming the first sheet is the data entry sheet
    ThisWorkbook.Worksheets(i).Range("C2").value = Sheet1.Range("B4").value  'Name
    'Add a line for each piece of data you need to copy
Next
End Sub

或者更简洁，但描述性较差的方法。同时显示循环。

POST

Answer 2

我现在有以下代码，但它只填写第一张表，而不是为我循环并填写其他表格：

Private Sub Setup_Sheets()
Dim Data_Entry As Worksheet          'You don't need variables. You can use Sheet1 and Sheet2 directly.
Set Data_Entry = Sheet1
Dim child1_sheet As Worksheet
Set child1_sheet = Sheet44            'Repeat for each child(sheet number is unqiue to your workbook)
Dim NameRange As Range
Set NameRange = Data_Entry.Range("B4")
child1_sheet.Range("C2").Value = NameRange.Value

Set NameRange = Data_Entry.Range("C4")
child1_sheet.Range("C3").Value = NameRange.Value

Set NameRange = Data_Entry.Range("D4")
child1_sheet.Range("C4").Value = NameRange.Value

Set NameRange = Data_Entry.Range("E4")
child1_sheet.Range("E5").Value = NameRange.Value

Set NameRange = Data_Entry.Range("G4")
child1_sheet.Range("G5").Value = NameRange.Value

Set NameRange = Data_Entry.Range("S4")
child1_sheet.Range("C9").Value = NameRange.Value

Set NameRange = Data_Entry.Range("AE4")
child1_sheet.Range("C10").Value = NameRange.Value

Set NameRange = Data_Entry.Range("AQ4")
child1_sheet.Range("C11").Value = NameRange.Value

Set NameRange = Data_Entry.Range("BC4")
child1_sheet.Range("C12").Value = NameRange.Value

Set NameRange = Data_Entry.Range("BE4")
child1_sheet.Range("F5").Value = NameRange.Value

End Sub

每个新的Excel工作表都链接到不同的数据行

2 个答案: