2016-05-31 75 views
0

我目前正致力于将数据从多个工作簿中的多个工作表解析为摘要工作表。我可以从所有工作表和工作簿中选择某些单元格,但如果可能的话,我想提取一系列的列。我怎样才能将这个选项添加到我的循环条件? 例如如果我有一个名为“星期一”的工作表,我想通过C57提取单元格范围A2并将其添加到我新创建的工作表中。从excel工作表中提取列范围

Option Explicit 
Sub GetMyData() 
Dim myDir As String, fn As String, SheetName As String, SheetName2 As String, SheetName3 As String, n As Long, NR As Long 
'***** Change Folder Path ***** 
myDir = "C:\attach" 

'***** Change Sheetname(s) ***** 
SheetName = "Title" 
SheetName2 = "Total" 
SheetName3 = "Monday" 

'***Loops through specified directory and parces data from each worksheet within each workbook by selecting specified . 
fn = Dir(myDir & "\*.xlsx") 
Do While fn <> "" 
    If fn <> ThisWorkbook.Name Then 
     With ThisWorkbook.Sheets("ImportTable") 
      NR = .Cells(Rows.Count, 1).End(xlUp).Row + 1 

      'Pick cells from worksheet "Title" 
      With .Range("A" & NR) 
       .Formula = "='" & myDir & "\[" & fn & "]" & SheetName & "'!A1" 
       .Value = .Value 
      End With 
      With .Range("B" & NR) 
       .Formula = "='" & myDir & "\[" & fn & "]" & SheetName & "'!A2" 
       .Value = .Value 
      End With 
      With .Range("C" & NR) 
       .Formula = "='" & myDir & "\[" & fn & "]" & SheetName & "'!B4" 
       .Value = .Value 
      End With 
      With .Range("D" & NR) 
       .Formula = "='" & myDir & "\[" & fn & "]" & SheetName & "'!B5" 
       .Value = .Value 
      End With 
      With .Range("E" & NR) 
       .Formula = "='" & myDir & "\[" & fn & "]" & SheetName & "'!B6" 
       .Value = .Value 
      End With 
      With .Range("F" & NR) 
       .Formula = "='" & myDir & "\[" & fn & "]" & SheetName & "'!B7" 
       .Value = .Value 
      End With 
      With .Range("G" & NR) 
       .Formula = "='" & myDir & "\[" & fn & "]" & SheetName2 & "'!B26" 
       .Value = .Value 
      End With 
      With .Range("H" & NR) 
       .Formula = "='" & myDir & "\[" & fn & "]" & SheetName2 & "'!A1" 
       .Value = .Value 
      End With 
     End With 
    End If 
    fn = Dir 
Loop 
ThisWorkbook.Sheets("ImportTable").Columns.AutoFit 
End Sub 
+0

你的意思是你想在一张纸上设置范围等于另一张纸上范围内的值? –

+0

是的。每个表格中总共有3列,我想在我的范围内定义。 – wisenhiemer

回答

0

如果将您的链路创建一个单独的子代码将更加简洁,可以自动具有子调整式的(经常为单细胞,或阵列式为单元的块)的类型

Sub tester() 

    Dim rng As Range 

    Set rng = ActiveSheet.Range("A2") 

    LinkToFile "C:\_Stuff\test", "temp report.xlsx", "Sheet1", "A1:D20", rng 

    Set rng = ActiveSheet.Range("F2") 

    LinkToFile "C:\_Stuff\test", "temp report.xlsx", "Sheet1", "A1", rng 

End Sub 




Sub LinkToFile(fPath As String, fName As String, shtName As String, _ 
       addr As String, rngInsert As Range) 

    Dim rngTmp As Range, f As String 

    If Right(fPath, 1) <> "\" Then fPath = fPath & "\" 'win only! 

    f = "='" & fPath & "[" & fName & "]" & shtName & "'!" & addr 

    'linking to a range, or a single cell ? 
    If InStr(addr, ":") > 0 Then 
     Set rngTmp = rngInsert.Parent.Range(addr) 'to get num rows/cols 
     rngInsert.Resize(rngTmp.Rows.Count, rngTmp.Columns.Count).FormulaArray = f 
    Else 
     rngInsert.Formula = f 
    End If 

End Sub 
相关问题