For Selected Row, so only 1 new file

Sub Selected_Row()
Dim ws1 As Worksheet, ws2 As Worksheet, x As Integer, myfile As String, mypath As String
Set ws1 = Sheets("Master")
x = ActiveCell.Row
myfile = ws1.Range("A" & x) & ".xlsx"
If Environ("Username") = "leova" Then
    mypath = ThisWorkbook.Path & "\"
    Else
    mypath = "D:\excelreport\BLOODGROUPCARDENT\"
End If
Application.ScreenUpdating = False
Sheets("CLINICAL").Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = ws1.Range("D" & x)
Set ws2 = Sheets(ws1.Range("D" & x).Value)
ws2.Range("B5").Resize(4).Value = Application.Transpose(Array(ws1.Range("BF" & x), ws1.Range("D" & x), ws1.Range("E" & x), ws1.Range("C" & x)))
ws2.Range("B11").Resize(5).Value = Application.Transpose(Array(ws1.Range("J" & x), ws1.Range("K" & x), ws1.Range("L" & x), ws1.Range("M" & x), ws1.Range("BG" & x)))
ws2.Range("B17").Resize(3).Value = Application.Transpose(Array(ws1.Range("Q" & x), ws1.Range("R" & x), ws1.Range("S" & x)))
ws2.Range("B22").Resize(3).Value = Application.Transpose(Array(ws1.Range("X" & x), ws1.Range("Y" & x), ws1.Range("BL" & x)))
ws2.Range("B38").Resize(2).Value = Application.Transpose(Array(ws1.Range("AG" & x), ws1.Range("AH" & x)))
ws2.Range("B41").Resize(9).Value = Application.Transpose(Array(ws1.Range("AI" & x), ws1.Range("AM" & x), ws1.Range("AO" & x), ws1.Range("AP" & x), ws1.Range("AQ" & x), _
    ws1.Range("BM" & x), ws1.Range("BN" & x), ws1.Range("BO" & x), ws1.Range("BP" & x)))
ws2.Range("B52").Value = ws1.Range("BD" & x)
ws2.Range("C26").Value = ws1.Range("AC" & x): ws2.Range("C28").Value = ws1.Range("AD" & x)
ws2.Range("C30").Value = ws1.Range("AE" & x): ws2.Range("C32").Value = ws1.Range("AF" & x)
ws2.Range("C41").Value = ws1.Range("AJ" & x)
ws2.Range("D7").Value = ws1.Range("G" & x)
ws2.Range("D22").Resize(2).Value = Application.Transpose(Array(ws1.Range("Z" & x), ws1.Range("AA" & x)))
ws2.Range("D41").Resize(2).Value = Application.Transpose(Array(ws1.Range("AK" & x), ws1.Range("AN" & x)))
ws2.Range("E17").Resize(3).Value = Application.Transpose(Array(ws1.Range("T" & x), ws1.Range("U" & x), ws1.Range("BJ" & x)))
ws2.Range("E41").Value = ws1.Range("AL" & x)
ws2.Range("F7").Resize(2).Value = Application.Transpose(Array(ws1.Range("H" & x), ws1.Range("B" & x)))
ws2.Range("F15").Value = ws1.Range("BH" & x)
ws2.Range("G38").Resize(7).Value = Application.Transpose(ws1.Range("AR" & x).Resize(, 7))
ws2.Range("H23").Value = ws1.Range("AB" & x)
ws2.Range("I5") = ws1.Range("BE" & x): ws2.Range("I11").Value = ws1.Range("N" & x): ws2.Range("I15").Value = ws1.Range("BI" & x)
ws2.Range("I7").Resize(2).Value = Application.Transpose(Array(ws1.Range("I" & x), ws1.Range("F" & x)))
ws2.Range("I17").Resize(3).Value = Application.Transpose(Array(ws1.Range("V" & x), ws1.Range("W" & x), ws1.Range("BK" & x)))
ws2.Range("I38").Resize(5).Value = Application.Transpose(ws1.Range("AY" & x).Resize(, 5))
ws2.Range("I43").Resize(2).Value = Application.Transpose(ws1.Range("BQ" & x).Resize(, 2))
ws2.Range("J12").Resize(2).Value = Application.Transpose(ws1.Range("O" & x).Resize(, 2))
ws2.Move
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs mypath & myfile
ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

For All

Sub All_Rows()
Dim ws1 As Worksheet, ws2 As Worksheet, x As Integer, myfile As String, mypath As String
Set ws1 = Sheets("Master")
If Environ("Username") = "leova" Then
    mypath = ThisWorkbook.Path & "\"
    Else
    mypath = "D:\excelreport\BLOODGROUPCARDENT\"
End If
Application.ScreenUpdating = False
For x = 2 To ws1.Range("A" & Rows.Count).End(xlUp).Row
    myfile = ws1.Range("A" & x) & ".xlsx"
    Sheets("CLINICAL").Copy after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = ws1.Range("D" & x)
    Set ws2 = Sheets(ws1.Range("D" & x).Value)
    ws2.Range("B5").Resize(4).Value = Application.Transpose(Array(ws1.Range("BF" & x), ws1.Range("D" & x), ws1.Range("E" & x), ws1.Range("C" & x)))
    ws2.Range("B11").Resize(5).Value = Application.Transpose(Array(ws1.Range("J" & x), ws1.Range("K" & x), ws1.Range("L" & x), ws1.Range("M" & x), ws1.Range("BG" & x)))
    ws2.Range("B17").Resize(3).Value = Application.Transpose(Array(ws1.Range("Q" & x), ws1.Range("R" & x), ws1.Range("S" & x)))
    ws2.Range("B22").Resize(3).Value = Application.Transpose(Array(ws1.Range("X" & x), ws1.Range("Y" & x), ws1.Range("BL" & x)))
    ws2.Range("B38").Resize(2).Value = Application.Transpose(Array(ws1.Range("AG" & x), ws1.Range("AH" & x)))
    ws2.Range("B41").Resize(9).Value = Application.Transpose(Array(ws1.Range("AI" & x), ws1.Range("AM" & x), ws1.Range("AO" & x), ws1.Range("AP" & x), ws1.Range("AQ" & x), _
        ws1.Range("BM" & x), ws1.Range("BN" & x), ws1.Range("BO" & x), ws1.Range("BP" & x)))
    ws2.Range("B52").Value = ws1.Range("BD" & x)
    ws2.Range("C26").Value = ws1.Range("AC" & x): ws2.Range("C28").Value = ws1.Range("AD" & x)
    ws2.Range("C30").Value = ws1.Range("AE" & x): ws2.Range("C32").Value = ws1.Range("AF" & x)
    ws2.Range("C41").Value = ws1.Range("AJ" & x)
    ws2.Range("D7").Value = ws1.Range("G" & x)
    ws2.Range("D22").Resize(2).Value = Application.Transpose(Array(ws1.Range("Z" & x), ws1.Range("AA" & x)))
    ws2.Range("D41").Resize(2).Value = Application.Transpose(Array(ws1.Range("AK" & x), ws1.Range("AN" & x)))
    ws2.Range("E17").Resize(3).Value = Application.Transpose(Array(ws1.Range("T" & x), ws1.Range("U" & x), ws1.Range("BJ" & x)))
    ws2.Range("E41").Value = ws1.Range("AL" & x)
    ws2.Range("F7").Resize(2).Value = Application.Transpose(Array(ws1.Range("H" & x), ws1.Range("B" & x)))
    ws2.Range("F15").Value = ws1.Range("BH" & x)
    ws2.Range("G38").Resize(7).Value = Application.Transpose(ws1.Range("AR" & x).Resize(, 7))
    ws2.Range("H23").Value = ws1.Range("AB" & x)
    ws2.Range("I5") = ws1.Range("BE" & x): ws2.Range("I11").Value = ws1.Range("N" & x): ws2.Range("I15").Value = ws1.Range("BI" & x)
    ws2.Range("I7").Resize(2).Value = Application.Transpose(Array(ws1.Range("I" & x), ws1.Range("F" & x)))
    ws2.Range("I17").Resize(3).Value = Application.Transpose(Array(ws1.Range("V" & x), ws1.Range("W" & x), ws1.Range("BK" & x)))
    ws2.Range("I38").Resize(5).Value = Application.Transpose(ws1.Range("AY" & x).Resize(, 5))
    ws2.Range("I43").Resize(2).Value = Application.Transpose(ws1.Range("BQ" & x).Resize(, 2))
    ws2.Range("J12").Resize(2).Value = Application.Transpose(ws1.Range("O" & x).Resize(, 2))
    ws2.Move
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs mypath & myfile
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
Next
Application.ScreenUpdating = True
End Sub
Kind regards
Leo