Add to sheet instead of overwrite

Hello, can someone help me?

When i run the sub's underneath one after the other the second one overwrites the data that the first sub has written to the "op" sheet. How can i make so that the second sub adds the data to sheet "op" instead of overwriting?

Nick

Sub op()

 

Dim shArr() As Variant

shArr = Array("Juni", "Juli", "Aug", "Sep")

 

Dim teamArr(0, 1) As Integer

teamArr(0, 0) = 4: teamArr(0, 1) = 6

 

Dim Arr() As Variant

ReDim Preserve Arr(31, 4)

 

shifts = "v;o;m;n"

Dim shiftArr() As String

shiftArr = Split(shifts, ";")

 

With Sheets("Op")

    .Cells(1, 1).CurrentRegion.clear

    .Cells(1, 1) = "Datum": .Cells(1, 2) = "ploeg": .Cells(1, 3) = "Dienst": .Cells(1, 4) = "Schuifdag": .Cells(1, 5) = "Aanvulling uit ploeg": .Cells(1, 6) = "Kantje": .Cells(1, 7) = "Naam": .Cells(1, 😎 = "Opmerking"

End With

 

rw = 2

 

For t = LBound(teamArr) To UBound(teamArr)

 

    For Each sheetname In shArr

   

        sr = teamArr(t, 0)

        ss = teamArr(t, 1)

   

        With Sheets(sheetname)

       

            team = .Cells(sr, 1).Value

       

            For x = 1 To UBound(Arr)

                Arr(x, 1) = .Cells(sr - 2, x + 3)

                If .Cells(4, x + 3) <> "" Then snum = .Cells(4, x + 3)

                Arr(x, 2) = snum

                Arr(x, 3) = .Cells(sr, x + 3)

                Arr(x, 4) = .Cells(ss, x + 3)

            Next x

           

        End With

       

        With Sheets("Op")

       

       

            For s = LBound(shiftArr) To UBound(shiftArr)

                For x = 1 To UBound(Arr)

                    If Arr(x, 2) <> Arr(x - 1, 2) Then recur = 1 Else recur = 2

                    If Arr(x, 4) < 0 And Arr(x, 3) = shiftArr(s) Then

                        Arr(x, 3) = Arr(x, 3) & recur

                        recur = recur + 1

                    End If

                Next x

            Next s

           

            For x = 1 To UBound(Arr)

                If Arr(x, 4) < 0 Then

                    For y = 1 To Abs(Arr(x, 4))

                        .Cells(rw, 1) = Arr(x, 1)

                        .Cells(rw, 2) = team

                        .Cells(rw, 3) = UCase(Arr(x, 3))

                        rw = rw + 1

                    Next y

                End If

            Next x

           

        End With

   

    Next sheetname

 

Next t

 

End Sub

 

Sub op2()

 

Dim shArr() As Variant

shArr = Array("Juni", "Juli", "Aug", "Sep")

 

Dim teamArr(0, 1) As Integer

teamArr(0, 0) = 14: teamArr(0, 1) = 16

 

Dim Arr() As Variant

ReDim Preserve Arr(31, 4)

 

shifts = "v;o;m;n"

Dim shiftArr() As String

shiftArr = Split(shifts, ";")

 

rw = 2

 

For t = LBound(teamArr) To UBound(teamArr)

 

    For Each sheetname In shArr

   

        sr = teamArr(t, 0)

        ss = teamArr(t, 1)

   

        With Sheets(sheetname)

       

            team = .Cells(sr, 1).Value

       

            For x = 1 To UBound(Arr)

                Arr(x, 1) = .Cells(sr - 2, x + 3)

                If .Cells(14, x + 3) <> "" Then snum = .Cells(14, x + 3)

                Arr(x, 2) = snum

                Arr(x, 3) = .Cells(sr, x + 3)

                Arr(x, 4) = .Cells(ss, x + 3)

            Next x

           

        End With

       

        With Sheets("op")

       

       

            For s = LBound(shiftArr) To UBound(shiftArr)

                For x = 1 To UBound(Arr)

                    If Arr(x, 2) <> Arr(x - 1, 2) Then recur = 1 Else recur = 2

                    If Arr(x, 4) < 0 And Arr(x, 3) = shiftArr(s) Then

                        Arr(x, 3) = Arr(x, 3) & recur

                        recur = recur + 1

                    End If

                Next x

            Next s

           

            For x = 1 To UBound(Arr)

                If Arr(x, 4) < 0 Then

                    For y = 1 To Abs(Arr(x, 4))

                        .Cells(rw, 1) = Arr(x, 1)

                        .Cells(rw, 2) = team

                        .Cells(rw, 3) = UCase(Arr(x, 3))

                        rw = rw + 1

                    Next y

                End If

            Next x

           

        End With

   

    Next sheetname

 

Next t

 

End Sub