VBA For循环命名范围错误

时间:2016-05-25 14:11:34

标签: excel vba excel-vba

我尝试使用for循环来从多个文件中获取数据,但不知何故,单个单元格范围或命名范围都不起作用:

Sub GetTTData()
   ' Original from:
   ' http://ccm.net/faq/24666-excel-vba-copy-data-to-another-workbook

   ' CopyOpenItems Macro
   ' Copy open items to sheet.
   '
   ' Keyboard Shortcut: Ctrl+Shift+O
   '
   Dim wbReport             As Workbook 'workbook where the data is to be pasted
   Dim wbTTData             As Workbook 'workbook from where the data is to copied
   Dim strName              As String   'name of the source sheet/ target workbook
   Dim fileName             As String
   Dim RAWDataSheet         As Worksheet
   Dim SourceDataSheet      As Worksheet
   Dim RAWData              As Range
   Dim SourceData           As Range
   Dim portName             As String
   Dim rCell                As Range
   Dim files                As Range

   'set to the current active workbook (the source book)
   Set wbReport = ThisWorkbook
   'select Departure Airport
   portName = Worksheets("Control").Range("Dep_Airport")
   Set files = Worksheets("Control").Range("All_Files")

   'select cell A2 on the target book
   Set RAWDataSheet = wbReport.Worksheets("RAW TT Data")
   RAWDataSheet.Activate
   Set RAWData = RAWDataSheet.Range(Range("A2"), ActiveCell.SpecialCells(xlLastCell))

   'clear existing values form target book
   RAWData.ClearContents

   For Each rCell In Range("files")

       'take source of TT Data from workbook and open file
       fileName = Worksheets("Control").Range("File_Path") + Worksheets("Control").Range("rCell")
       Set wbTTData = Workbooks.Open(fileName)

       'activate the source book
       wbTTData.Activate

       'clear any thing on clipboard to maximize available memory
       Application.CutCopyMode = False

       'copy the range from source book
       Set SourceDataSheet = wbTTData.Sheets("Sheet1")

       'filter RAW TT Data for Departure Airport
       Set RAWData = SourceDataSheet.Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell))
       RAWData.AutoFilter Field:=3, Criteria1:=Array(portName), Operator:=xlFilterValues

       Set SourceData = SourceDataSheet.Range(Range("A2"), ActiveCell.SpecialCells(xlLastCell))
       SourceData.Copy

       'paste the data on the target book
       RAWDataSheet.Range("A2").PasteSpecial

       'clear any thing on clipboard to maximize available memory
       Application.CutCopyMode = False

       'save the target book
       wbReport.Save

       'close the workbook
       wbTTData.Close savechanges:=False

   Next rCell

   'activate the source book again
   wbReport.Activate

   'clear memory
   Set wbReport = Nothing
   Set wbTTData = Nothing
   Set SourceDataSheet = Nothing
   Set SourceData = Nothing

End Sub

1 个答案:

答案 0 :(得分:1)

你有这个变量:

Dim files As Range

然后你在这里设置:

Set files = Worksheets("Control").Range("All_Files")

然后,当您开始循环时,您的代码是:

For Each rCell In Range("files")

我认为您的代码应该是:

For Each rCell In files