简体   繁体   中英

Extract a column range from excel worksheets

I am currently working on parsing data from multiple worksheets within multiple workbooks into a summary worksheet. I have been able to select certain cells from all sheets and workbooks but would like to extract a range of columns if possible. How can I add this option to my loop condition? for example If I have a worksheet called "Monday" and I would like to extract the cell range A2 through C57 and add it to my newly created worksheet.

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

If you move your link creation to a separate sub your code will be more concise, and you can have the sub automatically adjust the type of formula (regular for single cells, or array formula for blocks of cells)

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM