Sub ki169()
Dim sname(30) As String
Application.ScreenUpdating = False
ThisWorkbook.Activate
 i = 1
    For Each sheet_name In Worksheets
        sname(i) = sheet_name.Name
        i = i + 1
    Next
       shsu = i - 1
    Workbooks.Add
    fname2 = ActiveWorkbook.Name
For i = 1 To shsu
' 最終へシ−ト追加
   Windows(fname2).Activate
   Sheets.Add
   shn = ActiveSheet.Name
   scn = Sheets.Count
   Sheets(shn).Move After:=Sheets(scn)
   Sheets(shn).Name = sname(i)
 
'コピ−
   ThisWorkbook.Activate
    Sheets(sname(i)).Select
    Columns("A:A").Select
    Selection.Copy
     
   Windows(fname2).Activate
    Sheets(sname(i)).Select
    Range("A1").Select
    ActiveSheet.Paste
  Range("A1").Select
Next
'不要シ−ト削除
   For Each sheet_name In Worksheets
        sh = sheet_name.Name
        Worksheets(sh).Select
        aaa = ActiveSheet.UsedRange.Address
        If aaa = "$A$1" Then
           Application.DisplayAlerts = False
           ActiveWindow.SelectedSheets.Delete
           Application.DisplayAlerts = True
        End If
    Next
End Sub