跨工作簿粘贴

Sub t()
Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range


For Each ws In Worksheets
    If ws.Name <> Sheet1.Name Then
        Set rng = ws.[a1]
        Set rng = ws.Range("a2", ws.[b1].End(xlDown))
        Set rng2 = Cells(1, 1).End(xlDown)(2, 1)
        rng.Copy rng2
        rng2(1, 3).Resize(rng.Row, 1) = ws.Name
    End If
Next ws
End Sub