Insert variable number of rows
Readability

Naming
So, the first thing I would note is the poor naming. The way things are named right now makes it difficult to understand the code. So, to start, replace ws1 and ws2 with more meaningful names. The range variables are a little better, but could still use some improvement. I would also note that variables should be camelCased. These things simply make it easier to read the code.

ws1 &gt;&gt; sourceSheet
ws2 &gt;&gt; destSheet
rngtocopy &gt;&gt; rngToCopy &gt;&gt; sourceRange
rngFinal &gt;&gt; destRange
LastRow &gt;&gt; lastRow


The next thing to note is the abundance of single letter variable names. These are problematic. The only time you should use single letter variable names is for a loop counter. That's it. No exceptions. It is extremely difficult to map these letters to meanings while we're trying to understand logic. Will you remember what z is 6 months from now? I doubt it.

j &gt;&gt; lastSourceERow
z &gt;&gt; lastDestERow
k &gt;&gt; firstDestRow
x &gt;&gt; startRow
r &gt;&gt; destCell


Sidenote: Replacing r was a real PITA.
Lastly, Sub and Function names should have Verb-Noun type names. stuck() tells the dev using this code absolutely nothing. Perhaps CopyTheSmithReportRange() would be a good name.
WhiteSpace
Again, this is a readability thing. (I do promise to get around to a better way to do this, but first we do need to be able to read the code.)
You are indenting your code, which is good. I've seen worse, but it could be better. Indentation should visually tell me at what level we're currently working at. For example, consider this snippet.

Do While x &lt; z
    With ws2
        If j &gt; 0 Then
              ws2.Range((&quot;A&quot; &amp; k), ws2.Range(&quot;A&quot; &amp; k).Offset(j, 0)).EntireRow.Insert
                    Set r = Cells(r.Row + j, 1)

                    For i = 2 To rngtocopy.Rows.Count
                        With ws2.Range(&quot;K&quot; &amp; k)
                            .Offset(0, 0).Value = rngtocopy(i, 1)
                            .Offset(0, 1).Value = rngtocopy(i, 2)
                        End With
                    k = k + 1
                    Next i
        End If
        k = k + 4
    End With
x = x + 1
Loop


Everything starts fine with the Do loop and the With statement, but then you add an extra level of indentation after inserting the row. The rest of that block is logically on the same level, so it should be at the same indentation level. Also take note that your loop incrememtation happens at the same indentation level as the For and Next statements. It shouldn't. It should be one level deeper.
The other thing to note about whitespace is the good use of vertical whitespace. It can make all the difference to readability. Use an extra line (one, never two) to differentiate between logically different things that occur sequentially at the same level of indentation.
This is the code after making these readability changes.
Option Explicit

Sub CopyTheSmithReportRange()

    Dim sourceSheet As Worksheet
    Dim destSheet As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim lastDestERow As Long
    Dim lastSourceERow As Long
    Dim firstDestRow As Long
    Dim startRow As Long
    Dim sourceRange As Range
    Dim destRange As Range
    Dim destCell As Range

    firstDestRow = 3
    startRow = 1

    Set sourceSheet = Sheets(&quot;Calc&quot;)
    Set destSheet = Sheets(&quot;Dealer Orders&quot;)

    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, &quot;E&quot;).End(xlUp).Row
    lastSourceERow = sourceSheet.Cells(sourceSheet.Rows.Count, &quot;E&quot;).End(xlUp).Row
    lastDestERow = destSheet.Cells(destSheet.Rows.Count, &quot;E&quot;).End(xlUp).Row

    Set sourceRange = sourceSheet.Range(&quot;E2&quot;, sourceSheet.Cells(lastRow, &quot;F&quot;))
    Set destRange = destSheet.Range(&quot;K2&quot;, destSheet.Cells(lastRow, &quot;K&quot;))
    
    Set destCell = Range(&quot;A&quot; &amp; firstDestRow)
    Do While startRow &lt; lastDestERow
    
        With destSheet
            If lastSourceERow &gt; 0 Then
                
                destSheet.Range((&quot;A&quot; &amp; firstDestRow), destSheet.Range(&quot;A&quot; &amp; firstDestRow).Offset(lastSourceERow, 0)).EntireRow.Insert
                Set destCell = Cells(r.Row + lastSourceERow, 1)

                For i = 2 To sourceRange.Rows.Count
                
                    With destSheet.Range(&quot;K&quot; &amp; firstDestRow)
                        .Offset(0, 0).Value = sourceRange(i, 1)
                        .Offset(0, 1).Value = sourceRange(i, 2)
                    End With
                    
                    firstDestRow = firstDestRow + 1
                Next i
                
            End If
            
            firstDestRow = firstDestRow + 4
        End With
        
        startRow = startRow + 1
    Loop
End Sub


Refactoring
The first thing I notice is that there are a lot of similar variables declared and that the code is deeply nested. These are indications that the code is doing too much and is in violation of the Single Responsibility Principle. It will be our goal now to simplify the code.
There's a quick hit right at the beginning. There is no difference between lastSourceERow and lastRow. We can get rid of lastRow entirely. While we're at it, let's go ahead and extract a function for lastRow. You'll find yourself needing it a lot if you continue to write vba code.
Public Function LastRow(ws As Worksheet, column As Variant) As Long
    LastRow = ws.Cells(ws.Rows.Count, column).End(xlUp).Row
End Function

Note that this function will take input of either a column name (&quot;E&quot;) or integer index, so we could pass it the integer index if we so chose.
This simplifies variable initialization a bit, and we have one less declaration.
lastSourceERow = LastRow(sourceSheet, &quot;E&quot;)
lastDestERow = LastRow(destSheet, &quot;E&quot;)

Set sourceRange = sourceSheet.Range(&quot;E2&quot;, sourceSheet.Cells(lastSourceERow, &quot;F&quot;))
Set destRange = destSheet.Range(&quot;K2&quot;, destSheet.Cells(lastSourceERow, &quot;K&quot;))

Setting the ranges leaves a little to be desired though, so we'll use a bit of a hack to clean up those lines. Let's just concatenate the last row to a string indicating the ranges we want to work with.
Set sourceRange = sourceSheet.Range(&quot;E2:F&quot; &amp; lastSourceERow)
Set destRange = destSheet.Range(&quot;K2:K&quot; &amp; lastSourceERow)

Lets use a similar trick to replace this obtuse line.

destSheet.Range((&quot;A&quot; &amp; firstDestRow), destSheet.Range(&quot;A&quot; &amp; firstDestRow).Offset(lastSourceERow, 0)).EntireRow.Insert


With this
destSheet.Range(&quot;A&quot; &amp; firstDestRow &amp; &quot;:A&quot; &amp; lastSourceERow).EntireRow.Insert    

I'm honestly not a fan of concatenating cell addresses like this, but I think it does a world of good to the readability and maintainability of this code. While we're at it, I think this is useful enough to extract into it's own subroutine.
Public Sub InsertRows(ws As Worksheet, firstRow As Long, lastRow As Long)
    ws.Range(&quot;A&quot; &amp; firstRow &amp; &quot;:A&quot; &amp; lastRow).EntireRow.Insert
End Sub

Let's also remove the With destSheet. It's not serving much of a purpose other than to further nest the code. Let's also remove destRange as it's not being used at all. That brings us to here, which is getting somewhere.
Sub CopyTheSmithReportRange()

    Dim sourceSheet As Worksheet
    Dim destSheet As Worksheet
    Dim i As Long
    Dim lastDestERow As Long
    Dim lastSourceERow As Long
    Dim firstDestRow As Long
    Dim startRow As Long
    Dim sourceRange As Range
    Dim destCell As Range

    Set sourceSheet = Sheets(&quot;Calc&quot;)
    Set destSheet = Sheets(&quot;Dealer Orders&quot;)

    lastSourceERow = LastRow(sourceSheet, &quot;E&quot;)
    lastDestERow = LastRow(destSheet, &quot;E&quot;)

    Set sourceRange = sourceSheet.Range(&quot;E2:F&quot; &amp; lastSourceERow)

    firstDestRow = 3
    startRow = 1

    Set destCell = Range(&quot;A&quot; &amp; firstDestRow)
    Do While startRow &lt; lastDestERow

        If lastSourceERow &gt; 0 Then

            InsertRows destSheet, firstDestRow, lastSourceERow

            Set destCell = destSheet.Cells(destCell.Row + lastSourceERow, 1)

            For i = 2 To sourceRange.Rows.Count

                With destSheet.Range(&quot;K&quot; &amp; firstDestRow)
                    .Offset(0, 0).Value = sourceRange(i, 1)
                    .Offset(0, 1).Value = sourceRange(i, 2)
                End With

                firstDestRow = firstDestRow + 1
            Next i

        End If

        firstDestRow = firstDestRow + 4
        startRow = startRow + 1
    Loop
End Sub

But not quite there yet....

Now, instead of this Do While loop, let's iterate through a range of cells with a ForEach loop instead. But first, remove this line, it is also dead code.

       Set destCell = destSheet.Cells(destCell.Row + lastSourceERow, 1)


Actually, completely remove this variable. It's not actually used anywhere. Okay, now let's replace that do loop with a foreach.
Sub CopyTheSmithReportRange()

    Dim sourceSheet As Worksheet
    Dim destSheet As Worksheet
    Dim lastDestERow As Long
    Dim lastSourceERow As Long
    Dim firstDestRow As Long
    Dim startRow As Long
    Dim sourceRange As Range

    Set sourceSheet = Sheets(&quot;Calc&quot;)
    Set destSheet = Sheets(&quot;Dealer Orders&quot;)

    lastSourceERow = LastRow(sourceSheet, &quot;E&quot;)
    lastDestERow = LastRow(destSheet, &quot;E&quot;)

    Set sourceRange = sourceSheet.Range(&quot;E2:F&quot; &amp; lastSourceERow)

    firstDestRow = 3
    startRow = 1

    If lastSourceERow &gt; 0 Then

        InsertRows destSheet, firstDestRow, lastSourceERow
    
        Dim destRange As Range
        Set destRange = Range(&quot;K3:K&quot; &amp; lastSourceERow)
        
        Dim cell As Range, i As Long
        i = 2
        
        For Each cell In destRange
                
            cell.Value = sourceRange(i, 1)
            cell.Offset(0, 1).Value = sourceRange(i, 2)
                
            i = i + 1
        Next cell
    
    End If
End Sub

A lot just happened there, so let me explain.

Move the If lastSourceERow check and the row insertion out of the loop.
Reintroduce the destRange variable with a new purpose.
Write the values to the iterator cell range, instead of offsetting based on some counter variables.

Now there's just a little more clean up to do.

Let's check the source sheet for data prior to doing anything else.
Remove dead variables startRow &amp; lastDestERow and all related dead code.
Change firstDestRow from a variable to a constant, it's value no longer changes.

And we now have a subroutine that fits on a single screen without scrolling. We could probably extract another method, but this is good enough for me. The code below does exactly the same thing your original did.
Sub CopyTheSmithReportRange()

    Dim sourceSheet As Worksheet
    Dim destSheet As Worksheet
    Dim lastSourceERow As Long
    Dim sourceRange As Range
    
    Const firstDestRow As Long = 3

    Set sourceSheet = Sheets(&quot;Calc&quot;)
    Set destSheet = Sheets(&quot;Dealer Orders&quot;)

    lastSourceERow = LastRow(sourceSheet, &quot;E&quot;)

    If lastSourceERow &gt; 0 Then

        Set sourceRange = sourceSheet.Range(&quot;E2:F&quot; &amp; lastSourceERow)

        InsertRows destSheet, firstDestRow, lastSourceERow
    
        Dim destRange As Range
        Set destRange = Range(&quot;K3:K&quot; &amp; lastSourceERow)
        
        Dim cell As Range, i As Long
        i = 2
        For Each cell In destRange
                
            cell.Value = sourceRange(i, 1)
            cell.Offset(0, 1).Value = sourceRange(i, 2)
                
            i = i + 1
        Next cell
    
    End If
End Sub