合并Sheet宏

Sub hz() 
Dim bt, i, r, c, n, first As Long 
bt = 1 '表头有几行，这里的1就改成几 
Cells.Clear 
For i = 1 To Sheets.Count 
    If Sheets(i).Name <> ActiveSheet.Name Then 
        If first = 0 Then 
            c = Sheets(i).Cells(1, Columns.Count).End(xlToLeft).Column 
            Sheets(i).Range("A1").Resize(bt, c).Copy Range("A1") 
            n = bt + 1: first = 1 
        End If 
        r = Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row 
        Sheets(i).Range("A" & bt + 1).Resize(r - 1, c).Copy Range("A" & n) 
        n = n + r - bt 
    End If 
Next 
End Sub