新しいシートに2枚のシートをマージするVBコードが必要です。

Question

私はVBの初心者です。何か助けが必要です。私は2枚のシートを持っている優れた2013年のワークブックを持っています。 Sheet1は従業員名のリスト（列Aは20の名前）、dob（列B）などであり、Sheet2は空白の評価フォームです。 Sheet2全体（空白のフォーム）をコピーして新しいSheet3に貼り付けるコードが必要です。また、EmpNameをRow1からSheet3（D4）、指定したDOB（J4）などの指定されたセルにプルするコードが必要です。 Sheet1のすべての名前に対してこのプロセスを繰り返します。最終的な目標は、各従業員に1つずつ、評価の形で20枚のシートを含むワークブックを作成することです。このコードでタブに従業員の名前を付けることもできれば大変です。これは可能ですか？私は広範囲にオンラインで検索しており、何かを見つけることはできません。

ここは私の現在のコードです。私が言ったように、私はVBA初心者です。このコードは従業員リストから新しいシートを作成し、データをコピーしますが、今度はsheet2（evalフォーム）全体をコピーし、employee3の名前セルA1をsheet3のフォーム（新しいシート）をセルD4に追加します。

サブCreateSheetsFromEmployeeList（）

Dim nameSource 
Dim nameColumn  
Dim nameStartRow As Long  
Dim nameEndRow  As Long  
Dim employeeName As String 
Dim newSheet  As Worksheet  

nameSource = "Ayre" 
nameColumn = "A"  
nameStartRow = 2  

nameEndRow = Worksheets(nameSource).Cells(Rows.Count, nameColumn).End(xlUp).Row 
Do While (nameStartRow <= nameEndRow) 
    employeeName = Sheets(nameSource).Cells(nameStartRow, nameColumn) 
    employeeName = Trim(employeeName) 
    If (employeeName <> vbNullString) Then 
     On Error Resume Next 'do not throw error  
     Err.Clear 'clear any existing error 

     Sheets(employeeName).Name = employeeName  
     If (Err.Number > 0) Then  
      Err.Clear 
      On Error GoTo -1  
      Set newSheet = Sheets.Add(After:=Sheets(Sheets.Count)) 
      newSheet.Name = employeeName  

      Sheets(nameSource).Activate 
      LastCol = ActiveSheet.Cells(nameStartRow, Application.Columns.Count).End(xlToLeft).Column 
      Range(Cells(nameStartRow, 1), Cells(nameStartRow, LastCol)).Select 
      Selection.Copy 

      Sheets(employeeName).Activate 'NEW 
      Sheets(employeeName).Cells(1, "A").PasteSpecial 
      [a1].Select 'NEW 
      Application.CutCopyMode = False 
      Sheets(employeeName).Columns("A:K").AutoFit 
     End If 
    End If 
    nameStartRow = nameStartRow + 1  
Loop  
End Sub 

Answer 1

Record a macro

あなたは、マクロ、マクロレコーダーの記録、あなたのマクロが実行するアクションを完了するために必要なすべてのステップを記録すると。一度アクションを反復し、記録を停止してから、マクロを繰り返し表示して最終的なオートメーションマクロを構築します。

Answer 2

このコードは、あなたが必要とする基本的な原則を示しています

Sub ExampleForAngel() 
    Dim names As Worksheet 
    Set names = Worksheets("Sheet1") 
    Dim eval As Worksheet 
    Set eval = Worksheets("Sheet2") 
    Dim index As Long 
    index = 0 
    Dim name As String 
    While (names.Range("A1").Offset(index, 0).Value <> "") 
     name = names.Range("A1").Offset(index, 0) 
     eval.Copy after:=Worksheets(Worksheets.Count) 
     ActiveSheet.name = name 
     ActiveSheet.Range("A2").Value = name 
     index = index + 1 
    Wend 
End Sub