批量创建 抽取数据

Sub aa()
    Dim i As Integer
    i = 2
    Dim j As Integer
    
    
    For j = 1 To 18
        i = 2
        Worksheets.Add after:=Worksheets("sheet1")
        ActiveSheet.Name = CStr(j)
        Sheets(CStr(j)).Cells(i, 5) = j
        Sheets(CStr(j)).Cells(i, 1) = "姓名"
        Sheets(CStr(j)).Cells(i, 2) = Application.WorksheetFunction.VLookup(Sheets(CStr(j)).Cells(i, 5), Sheets("Sheet1").Range("A:D"), 2, 0)
        Sheets(CStr(j)).Cells(i, 3) = "性别"
        Sheets(CStr(j)).Cells(i, 4) = Application.WorksheetFunction.VLookup(Sheets(CStr(j)).Cells(i, 5), Sheets("Sheet1").Range("A:D"), 3, 0)
        Sheets(CStr(j)).Cells(i + 1, 1) = "年龄"
        Sheets(CStr(j)).Cells(i + 1, 2) = Application.WorksheetFunction.VLookup(Sheets(CStr(j)).Cells(i, 5), Sheets("Sheet1").Range("A:D"), 4, 0)
        
    Next
End Sub