Macro to pull in data from other excel sheets in a folder?

[tonywatsonhelp]

Hi everyone,

Ok so what i'm trying to do is this.

I have a document Called "Master Dashboard" with a sheet Called "Projects Data"

In this sheet Row1 has Headers of Project1,Project2 etc up to Project20 (A1:U1)

I have a Folder on my desktop called "Projects"
in this folder are up to 20 excel docs (All XLSM)

I want a macro that when run does this

Goes to Folder "Projects" and checks there are no more than 20 docs in folder,
If there are Message box "To Many Folders" and exit sub.

if not Open each folder, copy the data in Sheet"Control" Range(M1:M97) and paste it in "Master Dashboard" Sheet "Projects Data"
so the first would go Under Project1 in A2 next Project2 for however many projects there are.

Please help if you can

Thanks

Tony

 

[tonywatsonhelp]

Hi,
Can anyone help me on this? i've been trying but still stuck
Tony

 

[mumps]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook, wkbSource As Workbook
    Set wsDest = ThisWorkbook.Sheets("Projects Data")
    Dim LastRow As Long, sFile As String, sFolder As String
    Dim lColumn As Long
    lColumn = 1
    sFolder = (CreateObject("WScript.Shell").specialfolders("Desktop") & "\Projects\")
    sFile = Dir(sFolder & "*.xlsm")
    Do While sFile <> ""
        j = j + 1
        sFile = Dir
    Loop
    If j > 20 Then
        MsgBox ("There are more than 20 files in the folder.")
        Exit Sub
    End If
    ChDir sFolder
    strExtension = Dir(sFolder & "*.xlsm")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            .Sheets("Control").Range("M1:M97").Copy wsDest.Cells(2, lColumn)
            lColumn = lColumn + 1
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[tonywatsonhelp]

Thank you Mumps,
Really appreciate the help
Thanks
Tony

 

[mumps]

My pleasure.