How to adapt scatterplot scales, without reducing the resolution

Question

I wrote a macro that creates a scatter plot of my dataset, using VBA code. However, I want to reduce the y-scale of my plot by factor 10. This means I want to replace 0.0001 with 0.00001, to get the scale I want (line element.Value = element.Value / (3.14 * (0.01 / 2) ^ 2) * 0.0001). However, if I do so, the graph gets a little pixelated, see figure below.

I want the graph at the top, but I want the y-scale of the one at the bottom (divided by 10). Here is my entire code. Does anyone know what I am missing?

Option Explicit

Public Sub ExtractInformation()

'Delete all information before "s,s,N,s"
    Dim lastRowToDelete As Long
    Dim f As Range
    
    'Rename sheet
    Dim SheetNameNew As String
    
    ActiveSheet.Name = "RawData"
    
    Debug.Print SheetNameNew
    
    With ThisWorkbook.Worksheets("RawData") '<-- reference your worksheet
        With Range("A1", .Cells(.Rows.Count, 1).End(xlUp)) '<-- reference its columns "A" cells from row 1 sown to last not empty one
            Set f = .Find(what:="s,s,N,s", LookIn:=xlValues, lookat:=xlWhole, After:=.Range("A" & .Rows.Count)) '<-- look for the first cell whose value is "**GRAD"
            If f Is Nothing Then '<-- if not found then...
                lastRowToDelete = .Rows(.Rows.Count).row '<-- the last row to delete is the last row of the range
            Else '<-- otherwise...
                lastRowToDelete = f.row - 1 '<-- the last row to delete is the one preceeding the one with the found cell
            End If
    End With
    If lastRowToDelete > 0 Then .Range("A1:A" & lastRowToDelete).EntireRow.Delete 'delete all rows in a single shot
End With

'Delete "s,s,N,s"
Worksheets("RawData").Rows(1).EntireRow.Delete

'Text to columns
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
    True 'Assuming there are always for columns
    
'P=F/A Pressure = Force / Surface area
' Calculate the number of rows of the Force column
Dim NumRowsForce As Integer
NumRowsForce = Range("C1", Range("C1").End(xlDown)).Rows.Count

Debug.Print 'NumRowsForce = ', NumRowsForce

'Copy column C to column E
Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).row).Copy Destination:=Range("E1")

'P=F/A
Dim element As Range
Dim MaxRows As Long

With Worksheets("RawData")
    MaxRows = .Cells(.Rows.Count, "E").End(xlUp).row
End With

For Each element In Worksheets("RawData").Range("E1:E" & MaxRows)
    If IsNumeric(element.Value) Then
        element.Value = element.Value / (3.14 * (0.01 / 2) ^ 2) * 0.0001
    End If
Next

'Copy column E to column F
Range("E1:E" & Cells(Rows.Count, "E").End(xlUp).row).Copy Destination:=Range("F1")

For Each element In Worksheets("RawData").Range("F1:F" & MaxRows)
    If element = "" Then Exit Sub
    element.Value = WorksheetFunction.Round(element.Value, 1)
Next element

'Copy column F to column G
Range("F1:F" & Cells(Rows.Count, "F").End(xlUp).row).Copy Destination:=Range("G1")

''NYNKE''
Dim x As Integer
Dim r As Integer
Dim c As Integer

'Add new sheet
Sheets.Add.Name = "Graphs"
Sheets("Graphs").Move After:=Sheets(Sheets.Count)

' Turn off screenupdating:
Application.ScreenUpdating = False
  
'Select cell G1.
Sheets("RawData").Select
Range("G1").Select

' Establish "For" loop to loop "numrows" number of times.
r = 1
c = 12
x = 2

For x = 2 To NumRowsForce - 2
  
  If Range("G" & x).Value > -10 Then
    Range("G" & x).Copy Destination:=Range(Cells(r, c), Cells(r, c))
        
    'Range("G" & x).Select
    'Selection.Copy
    'Cells(r, c).Select
    'ActiveSheet.Paste
    r = r + 1
  End If

  If Range("G" & x + 1).Value = 0 And Range("G" & x - 1).Value = 0 And Range("G" & x + 2).Value <> 0 Then
      c = c + 1
      r = 1
        
  End If
           
  Range("F" & x).Select
  Next x
  
  ' NumRowsL = Range("L1", Range("L1").End(xlDown)).Rows.Count
  v = 0

  For i = 1 To 120
        
  Cells(i, 11).Select
  ActiveCell.FormulaR1C1 = v
  v = v + 1
  
  Next i
     
  Sheets("RawData").Select
  Columns("K:DZ").Select
  Application.CutCopyMode = False
  Selection.Cut
  Sheets("Graphs").Select
  Range("A1").Select
  ActiveSheet.Paste
  
  'Remove incomplete and empty rows
  Application.ScreenUpdating = False
  Dim Target As Range
  Set Target = Sheets("Graphs").UsedRange.Offset(, 1).EntireColumn

  'If the column contains less than 60 rows, then remove the entire row
  Dim d As Long
  For d = Target.Columns.Count To 1 Step -1
      If WorksheetFunction.CountA(Target.Columns(d)) < 60 Then Target.Columns(d).Delete Shift:=xlToLeft 'The value can be changed
  Next
  
  'https://stackoverflow.com/questions/79039907/calculate-average-of-both-the-columns-and-rows-using-vba?noredirect=1#comment139365906_79039907
    Dim lastCol As Long, lastRow As Long, row As Long, col As Long, lastColLetter As String
    Dim rng As Range
    
    'Find the last column.
    'Assumes the relevant column is the last one with data in row 5.
    With Sheets("Graphs")
        lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        lastRow = .Cells(Rows.Count, "A").End(xlUp).row
        lastColLetter = Split(Cells(1, Columns.Count).End(xlToLeft).Address, "$")(1)
        'lastColLetter = Chr(34) & lastColLetter & Chr(34)
        'Debug.Print "lastColLetter = ", lastColLetter
        
        
        'Iterate the columns from 2 (ie "B") to the last.
        For col = 2 To lastCol
            Set rng = .Range(.Cells(1, col), .Cells(lastRow, col))
            .Cells(lastRow + 1, col) = getAvg(rng)
        Next
              
        'Iterate the rows from 1 last row
        For row = 1 To lastRow
            Set rng = .Range(.Cells(row, 2), .Cells(row, lastCol))
            .Cells(row, lastCol + 1) = getAvg(rng)
        Next
    End With
    
  'Create chart
  'Columns("A:DZ").Select
  ActiveSheet.Shapes.AddChart2(240, xlXYScatterLinesNoMarkers).Select
  ActiveChart.SetSourceData Source:=Range("Graphs!$A:$AL")
  ActiveChart.ChartTitle.Select
  ActiveChart.ChartTitle.Text = "Pressure over time"

  With ActiveChart
    With .Axes(xlCategory, xlPrimary)
      .HasTitle = True
      .AxisTitle.Text = "Foaming time [s]"
      .MaximumScale = 120
    End With
    With .Axes(xlValue, xlPrimary)
      .HasTitle = True
      .AxisTitle.Text = "Pressure [bar]"
    End With
    .HasLegend = False
  End With

End Sub

Public Function getAvg(rng As Range) As Variant
    On Error Resume Next
    getAvg = WorksheetFunction.AverageIf(rng, "<>")
    On Error GoTo 0
End Function