それぞれの新しいExcelワークシートが異なる行のデータにリンクされている

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ですが、子2のワークシートではC2とE5です。子3 = B6など。

私は、非常に大きなオリジナルシートから、各子供に関連する別々のワークシート上に配置する必要がある10個の別個の情報を持っています。これを行う方法はありますか、手動でデータ入力のB4セルに戻って、子1ワークシートのC2セルを手動でリンクする必要がありますか？私は約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のワークシートを持っていますか？または、それぞれ10人の子供と言う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 = Sheet2   '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 
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 'Name 
    'Add a line for each piece of data you need to copy 
Next 
End Sub 

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