Macro to distribute data within the sheets based on tabs name
Use any method that make a "directly-interation" with worksheet like copy, paste, range.value = something (...) intensifies the runtime of the code. To solve this you need to create an array to store the SourceSh.Rows(r) values. Before the loop change spreadsheet you parse all values stored in the array to cells using the method that I will show in the example. When the loop change spreadsheet you clear the array.

With that I think that you will have at least 65% better performance.

I created an example comparing runtime of the array method with the single value method, 
to 20k cells. See the difference?

[

Sub Compare()

Dim arr() As Variant
Dim max As Long
Dim start As Double

start = Timer

max = 20000
ReDim arr(max)

Application.ScreenUpdating = False

'Using the array method

For i = 1 To max

    arr(i) = i

Next i

Sheets("Planilha1").Range("A1:A" &amp; UBound(arr) + 1) = WorksheetFunction.Transpose(arr)
Debug.Print "Array method in seconds: " &amp; Round(Timer - start, 2)


'Parsing single values method

start = Timer

For i = 1 To UBound(arr)

    Sheets("Planilha1").Range("A1:A" &amp; UBound(arr) + 1) = i

Next i

Debug.Print "Value method in seconds: " &amp; Round(Timer - start, 2)


Application.ScreenUpdating = True

End Sub