循环遍历列并创建工作表，错误 1004答案

【问题标题】：Looping through columns and creating worksheets, error 1004循环遍历列并创建工作表，错误 1004
【发布时间】：2015-04-24 14:42:34
【问题描述】：

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

当我运行以下代码时，会创建文件和第一张工作表（第一列被复制并转置到新文件中）。然而，在那之后我得到了运行时错误'1004'。我尝试从不同的列开始，但在创建第一个列后仍然会出错。

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

【问题讨论】：

你从哪里得到运行时错误？您是否尝试过调试以查看发生了什么？
Workbooks("Categories_by_Year.xlsm").Worksheets(CStr(year)).Range(Cells(2, col), Cells(LastRow, col)).Copy
错误只是说“运行时错误'1004'。”？
Cells() 必须使用工作表进行限定，或者它指的是 ActiveSheet，即使如果它包含在对 Range() 的调用中，我建议您使用变量引用工作簿和工作表对象，以减少那里的代码量。

标签： vba excel

【解决方案1】：

未经测试：

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

【讨论】：