遍历列并创建工作表，错误1004

Question

I have an original file "Categories_by_Year.xlsm" where I have sheets for each year between 2010 and 2014 containing different categories and data (one category per column). What I want is for each year a new workbook to be created and than each category to be saved as a new worksheet in the file. The first row of each column is the category name, which is used for the new worksheets' names. From row 2 to the last not empty row - the data is copied and then transposed in the new worksheet.

When I run the following code, the file and the first sheet is created (the first column is copied and transposed in the new file). However, after that i got run-time error '1004'. I tried starting with different columns and it still trows an error after creating the first one.

Sub NewShForEachCategory()
Dim LastRow As Double

For year = 2010 To 2014

      Workbooks.Add
      ActiveWorkbook.SaveAs Filename:="C:\" & CStr(year) & ".xls", FileFormat:=xlExcel8

      Workbooks("Categories_by_Year.xlsm").Activate

For col = 1 To 35

  If Not IsEmpty(Workbooks("Categories_by_Year.xlsm").Worksheets(CStr(year)).Cells(1, col)) Then

  Category = Workbooks("Categories_by_Year.xlsm").Worksheets(CStr(year)).Cells(1, col).Value
  LastRow = Workbooks("Categories_by_Year.xlsm").Worksheets(CStr(year)).Cells(Rows.Count, col).End(xlUp).Row

   Workbooks("Categories_by_Year.xlsm").Worksheets(CStr(year)).Range(Cells(2, col), Cells(LastRow, col)).Copy
   Workbooks(CStr(year) & ".xls").Activate
   Workbooks(CStr(year) & ".xls").Worksheets.Add.Name = Category
   Workbooks(CStr(year) & ".xls").Worksheets(Category).Cells(1, 1).PasteSpecial Transpose:=True
  End If

Next col

Next year

End Sub

Answer 1

Untested:

Sub NewShForEachCategory()

Dim wbCBY as Workbook, wbY as Workbook, Category
Dim sht as Worksheet, year as Long, col as Long

    Set wbCBY = Workbooks("Categories_by_Year.xlsm")

    For year = 2010 To 2014

         Set wbY = Workbooks.Add()
         wbY.SaveAs Filename:="C:\" & CStr(year) & ".xls", _
                   FileFormat:=xlExcel8

         Set sht = wbCBY.Worksheets(CStr(year))

         For col = 1 To 35

            Category = Trim(sht.Cells(1, col).Value)

            If Len(Category) > 0 Then

              sht.Range(sht.Cells(2, col), _
                        sht.Cells(sht.Rows.Count, col).End(xlUp)).Copy

              With wbY.Worksheets.Add()
                 .Name = Category
                 .Cells(1, 1).PasteSpecial Transpose:=True
              End With

            End If

        Next col

    Next year

End Sub