2016-05-31 37 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 
相關問題