Help with Transposing Code

Hi

Try this

Sub aaa()
  Dim OutSh As Worksheet
  Set OutSh = Sheets("Sheet1")
  
  OutSh.Range("A1:Z1").Value = Array("ID", "visit", "study", "MET", "TRAIN", "AGE", "Height ", "Weight", "%BF", "Race", "Meds", "DR", "BSA", "BMI", "***", "MWL", "duration of ex", "Date of Test", "PWV", "cf", "MAP", "cr", "MAP", "v02_0", "VO2_25", "VO2_50")
  OutSh.Range("AA1:AZ1").Value = Array("VO2_75", "VO2_100", "VO2_125", "VO2_150", "VO2_175", "VO2_200", "VO2_225", "vo2max", "VCo2_0", "VCo2_25W", "VCo2_50W", "VCo2_75W", "VCo2_100W", "VCo2_125W", "VCo2_150W", "VCo2_175W", "VCo2_200W", "VCo2_225W", "VCO2max", "RER_0", "RER_25", "RER_50", "RER_75", "RER_100", "RER_125", "RER_150")
  OutSh.Range("BA1:BZ1").Value = Array("RER_175", "RER_200", "RER_225", "RER_max", "VE_0", "VE_25", "VE_50", "VE_75", "VE_100", "VE_125", "VE_150", "VE_175", "VE_200", "VE_225", "VE_max", "VT_0", "VT_25", "VT_50", "VT_75", "VT_100", "VT_125", "VT_150", "VT_175", "VT_200", "VT_225", "VT_max")
  OutSh.Range("CA1:CZ1").Value = Array("BORG_0", "BORG_25", "BORG_50", "BORG_75", "BORG_100", "BORG_125", "BORG_150", "BORG_175", "BORG_200", "BORG_225", "BORG_max", "SBP_0", "SBP_25", "SBP_50", "SBP_75", "SBP_100", "SBP_125", "SBP_150", "SBP_175", "SBP_200", "SBP_225", "SBP_max", "DBP_0", "DBP_25", "DBP_50", "DBP_75")
  OutSh.Range("DA1:DR1").Value = Array("DBP_100", "DBP_125", "DBP_150", "DBP_175", "DBP_200", "DBP_225", "DBP_max", "HR_0", "HR_25", "HR_50", "HR_75", "HR_100", "HR_125", "HR_150", "HR_175", "HR_200", "HR_225", "HR_max")
  
  For i = 3 To Cells(Rows.Count, "U").End(xlUp).Row
    If Len(Cells(i, "U")) > 0 Then
      outrow = OutSh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
      rzrows = Cells(i + 1, 45).End(xlDown).Row - i
      OutSh.Cells(outrow, 1).Resize(1, 2).Value = Cells(i, 1).Resize(1, 2).Value
      OutSh.Cells(outrow, 3).Resize(1, 16).Value = Cells(i, 4).Resize(1, 16).Value
      OutSh.Cells(outrow, 20).Resize(1, 4).Value = Cells(i, 40).Resize(1, 4).Value
      OutSh.Cells(outrow, 24).Resize(1, rzrows).Value = WorksheetFunction.Transpose(Cells(i + 1, 45).Resize(rzrows, 1).Value)
      OutSh.Cells(outrow, 35).Resize(1, rzrows).Value = WorksheetFunction.Transpose(Cells(i + 1, 46).Resize(rzrows, 1).Value)
      OutSh.Cells(outrow, 46).Resize(1, rzrows).Value = WorksheetFunction.Transpose(Cells(i + 1, 47).Resize(rzrows, 1).Value)
      OutSh.Cells(outrow, 57).Resize(1, rzrows).Value = WorksheetFunction.Transpose(Cells(i + 1, 48).Resize(rzrows, 1).Value)
      OutSh.Cells(outrow, 68).Resize(1, rzrows).Value = WorksheetFunction.Transpose(Cells(i + 1, 49).Resize(rzrows, 1).Value)
      OutSh.Cells(outrow, 79).Resize(1, rzrows).Value = WorksheetFunction.Transpose(Cells(i + 1, 50).Resize(rzrows, 1).Value)
      OutSh.Cells(outrow, 90).Resize(1, rzrows).Value = WorksheetFunction.Transpose(Cells(i + 1, 51).Resize(rzrows, 1).Value)
      OutSh.Cells(outrow, 101).Resize(1, rzrows).Value = WorksheetFunction.Transpose(Cells(i + 1, 52).Resize(rzrows, 1).Value)
      OutSh.Cells(outrow, 112).Resize(1, rzrows).Value = WorksheetFunction.Transpose(Cells(i + 1, 53).Resize(rzrows, 1).Value)
    End If
  Next i
  
  OutSh.Activate
  lastrow = Cells(Rows.Count, 1).End(xlUp).Row
  formarr = Array("AH", "AS", "BD", "BO", "BZ", "CK", "CV", "DG", "DR")
  For i = LBound(formarr) To UBound(formarr)
      Range(formarr(i) & 2).Formula = "=MAX(rc[-10]:rc[-1])"
      Range(formarr(i) & 2).AutoFill Destination:=Range(formarr(i) & "2:" & formarr(i) & lastrow)
  Next i  
  
End Sub

rylo