append copied data to the last used row

This should place the copied sheets on the next row without a blank row between.

Sub ConsolidateCommSheetFromAllWbk()
    Dim folpath As String, wbk As Workbook, shtname As String
    Dim fs, fol As Object, f
        With Application.FileDialog(msoFileDialogFolderPicker)
            .Show
            folpath = .SelectedItems(1)
        End With
    Set fs = CreateObject("scripting.filesystemobject")
    Set fol = fs.getfolder(folpath)
    Sheets(1).Cells.Clear
    'Sheets(1).Cells(1, 1) = "Heading-1"
    shtname = InputBox("Enter SheetName")
        For Each f In fol.Files
            If UCase(fs.getextensionname(f.Name)) = "XLSX" Or _
                UCase(fs.getextensionname(f.Name)) = "XLS" Then
                Set wbk = Workbooks.Open(f.Path)
                If Application.CountA(wbk.Sheets(shtnme).UsedRange) <> 0 Then
                    If Application.CountA(ThisWorkbook.Sheets(1).Rows(1)) = 0 Then
                        wbk.Sheets(shtname).UsedRange.Copy _
                        ThisWorkbook.Sheets(1).Range("A1")
                    Else
                        wbk.Sheets(shtname).UsedRange.Copy _
                        ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp)(2)
                    End If
                End If
                'Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
                wbk.Close False
            End If
        Next
        'Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
    Set sht = Nothing
    Set fol = Nothing
    Set fs = Nothing
    Set f = Nothing
    ActiveSheet.UsedRange.Rows.AutoFit
    MsgBox "It's Done"
End Sub