循环遍历列并创build工作表，错误1004

我有一个原始文件“Categories_by_Year.xlsm”，其中包含2010年至2014年间每年包含不同类别和数据（每列一个类别）的工作表。 我想要的是每年创build一个新的工作簿，并将每个类别作为新的工作表保存在文件中。 每列的第一行是类别名称，用于新工作表的名称。 从第2行到最后一个非空行 – 数据被复制，然后在新的工作表中转置。

当我运行下面的代码时，将创build文件和第一个工作表（第一列被复制并转置到新文件中）。 但是，之后，我得到了运行时错误“1004”。 我尝试从不同的列开始，并创build第一个后，它仍然会导致错误。

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

未经testing：

 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