WELCOME to MrExcel!
This should be close to what you need. We don't know your skills and knowledge, but I hope you will take the time to analyse this, so you can learn and progress. Good luck!
kind regards,Code:Option Explicit Sub test() Dim LastRow As Long Dim i As Long Dim j As Long j = 1 Application.ScreenUpdating = False With Sheets("Canada") LastRow = .Range("F" & Rows.Count).End(xlUp).Row For i = 851 To LastRow Step 37 j = j + 1 .Range("F" & i & ":F" & i + 36).Copy Sheets("Alberta").Range("A" & j).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True Next i End With Application.ScreenUpdating = True End Sub