Incomplete Range

Stephanie,

See if this gives you what you are wanting. I have simply made a few modifications to your code. If it is not exactly what you are wanting, let me know and we can continue to modify until it is what you want.

Sub Test2()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim shLast As Long
    Dim lRow As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Delete the sheet "YearSheet" if it exist
    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Worksheets("YearSheet").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    'Add a worksheet with the name "YearSheet"
    Set DestSh = ThisWorkbook.Worksheets.Add
    DestSh.Name = "YearSheet"
     DestSh.Cells(1, 1).Value = "Month"
      DestSh.Cells(1, 2).Value = "Instructor"
       DestSh.Cells(1, 3).Value = "Department"
        DestSh.Cells(1, 4).Value = "Duration"
         DestSh.Cells(1, 5).Value = "Topic"
          DestSh.Cells(1, 6).Value = "Workshop"
 'loop through all worksheets and copy the data to the DestSh
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> DestSh.Name And sh.Visible = True Then
            Last = LastRow(DestSh) + 1
            DestSh.Cells(Last, "A").Value = sh.Name
            shLast = LastRow(sh)
            For lRow = 2 To shLast Step 1
                sh.Range(sh.Cells(lRow, 3), sh.Cells(lRow, 10)).Copy
                With DestSh.Cells(Last, 2)
                   .PasteSpecial xlPasteValues, , False, False
                   .PasteSpecial xlPasteFormats, , False, False
                   Application.CutCopyMode = False
                End With
                Last = Last + 1
            Next lRow

        End If
  Next
  
  Application.Goto DestSh.Cells(1)
  
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub