One word.... VELOCIRAPTORS.
You seem like a nice guy, I don't want the raptors to get you, so let's take Heslacher's advice and move this code outside of the loop.
If i = 2 Then
wsDest.Range("A1:C" & iSource).Value2 = wsSource.Range("A1:C" & iSource).Value2
wsSource.Range("A1:C" & iSource).Delete (xlShiftUp)
GoTo NextI
End If
Since we'll handling the special case of the first row outside the loop, we need to change which row the loop starts on. While we're at it, let's get rid of that magic number and replace it with a variable. Note that I also replaced i with the more meaningful name row.
iSource = wsTotals.Range("B2").Value
wsDest.Range("A1:C" & iSource).Value2 = wsSource.Range("A1:C" & iSource).Value2
wsSource.Range("A1:C" & iSource).Delete (xlShiftUp)
Dim startRow As Long
startRow = 3
For row = startRow To iLast
iSource = wsTotals.Range("B" & i).Value
iDest = wsDest.Range("A99999").End(xlUp).Row
Now that the dreaded GoTo has been banished, let's see what else we can clean up.
There's no sense in assigning ThisWorkbook to a variable. There's no need to keep an extra reference to it in memory. Just do this. (Note that although I hate hungarian notation, I find using wb for workbook and ws for worksheet acceptable. The intention is clear to any VBA developer.)
Set wsTotals = ThisWorkbook.Worksheets("Totals")
Set wsSource = ThisWorkbook.Worksheets("Source")
Set wsDest = ThisWorkbook.Worksheets("Dest")
Your method of finding the last row has unpredictable results. Use this instead.
lastRow = wsTotals.Range("A" & wsTotals.Rows.Count).End(xlUp).row
Same deal with finding the destination row.
iDest = wsDest.Range("A" & wsDest.Rows.Count).End(xlUp).row
Applying most of Vogel612's naming suggestions, this is the code up to this point.
Sub WeaveSort()
Dim wsDest As Worksheet
Dim wsSource As Worksheet
Dim wsTotals As Worksheet
Dim row As Integer
Dim lastRow As Integer
Dim destinationRow As Integer
Dim sourceRow As Integer
Dim oldRow As Integer
Dim newRow As Integer
Dim difference As Double
Dim differenceSum As Double
Set wsTotals = ThisWorkbook.Worksheets("Totals")
Set wsSource = ThisWorkbook.Worksheets("Source")
Set wsDest = ThisWorkbook.Worksheets("Dest")
lastRow = wsTotals.Range("A" & wsTotals.Rows.Count).End(xlUp).row - 1
sourceRow = wsTotals.Range("B2").Value
wsDest.Range("A1:C" & sourceRow).Value2 = wsSource.Range("A1:C" & sourceRow).Value2
wsSource.Range("A1:C" & sourceRow).Delete (xlShiftUp)
Dim startRow As Long
startRow = 3
For row = startRow To lastRow
sourceRow = wsTotals.Range("B" & row).Value
destinationRow = wsDest.Range("A" & wsDest.Rows.Count).End(xlUp).row
difference = destinationRow / sourceRow
differenceSum = 0
newRow = 0
For oldRow = 1 To sourceRow
difference = destinationRow / sourceRow
differenceSum = differenceSum + difference
newRow = Round(differenceSum, 0)
wsSource.Rows(oldRow).Copy
wsDest.Rows(newRow).Insert xlShiftDown
destinationRow = destinationRow + 1
Next oldRow
wsSource.Range("A1:C" & sourceRow).Delete (xlShiftUp)
Next row
End Sub
We introduced a little duplication when we got rid of the raptors. Let's introduce a sub to delete the data from the source. To make things easy, we'll declare the different worksheets at the module level.
Option Explicit
Private wsDest As Worksheet
Private wsSource As Worksheet
Private wsTotals As Worksheet
Private Sub DeleteFromSource(ByVal row As Long)
wsSource.Range("A1:C" & row).Delete (xlShiftUp)
End Sub
Changing WeaveSort to:
Sub WeaveSort()
Dim row As Integer
Dim lastRow As Integer
Dim destinationRow As Integer
Dim sourceRow As Integer
Dim oldRow As Integer
Dim newRow As Integer
Dim difference As Double
Dim differenceSum As Double
Set wsTotals = ThisWorkbook.Worksheets("Totals")
Set wsSource = ThisWorkbook.Worksheets("Source")
Set wsDest = ThisWorkbook.Worksheets("Dest")
lastRow = wsTotals.Range("A" & wsTotals.Rows.Count).End(xlUp).row - 1
sourceRow = wsTotals.Range("B2").Value
wsDest.Range("A1:C" & row).Value2 = wsSource.Range("A1:C" & row).Value2
DeleteFromSource sourceRow
Dim startRow As Long
startRow = 3
For row = startRow To lastRow
sourceRow = wsTotals.Range("B" & row).Value
destinationRow = wsDest.Range("A" & wsDest.Rows.Count).End(xlUp).row
difference = destinationRow / sourceRow
differenceSum = 0
newRow = 0
For oldRow = 1 To sourceRow
difference = destinationRow / sourceRow
differenceSum = differenceSum + difference
newRow = Round(differenceSum, 0)
wsSource.Rows(oldRow).Copy
wsDest.Rows(newRow).Insert xlShiftDown
destinationRow = destinationRow + 1
Next oldRow
DeleteFromSource sourceRow
Next row
End Sub
Ultimately leaving this clever solution unchanged, but much more understandable.
