Hi all,

Mostly thanks to romperstomper, I have been using the below code to pull a range from a number of files and copy them all in to a new sheet. However, I now need to copy the range in to one of a number of sheets (3 at the moment) depending on the contents of the first cell.

Pretty sure I should be able to do this myself eventually, but I'm runnin short on time and so I could use your expert help again.

Many thanks

Matt


Sub DoProcessing()
    ProcessAllWorkbooksInFolder "K:\Cndadm\Pulse Survey Test", "Training*.xls", False
End Sub
Sub ProcessAllWorkbooksInFolder(strParentFolder As String, Optional strFilter As String = "*.xls", Optional blnDoSubFolders As Boolean = False)
        
    Dim FS As FileSearch
    Dim lngCounter As Long
    Dim wbk As Workbook
    Dim wksOut As Worksheet
    Dim rngOut As Range
    
    Application.ScreenUpdating = False
        
    Set wksOut = ActiveSheet
    
    Set rngOut = wksOut.Range("C4")
    
    Set FS = Application.FileSearch
    With FS
        .NewSearch
        .LookIn = strParentFolder
        .SearchSubFolders = blnDoSubFolders
        ' adjust as required
        .Filename = strFilter
        .MatchTextExactly = True
        .FileType = msoFileTypeExcelWorkbooks
        .Execute
              
        For lngCounter = 1 To .FoundFiles.Count
            Set wbk = Workbooks.Open(.FoundFiles(lngCounter))
            ProcessWorkbook wbk, rngOut
            wbk.Close False
            Set rngOut = wksOut.Cells(1, Columns.Count).End(xlToLeft).Offset(, 1)
        Next lngCounter
        
        Set wbk = Nothing
    End With
    Set FS = Nothing
    Application.ScreenUpdating = True
End Sub

Sub ProcessWorkbook(wbk As Workbook, rngDest As Range)
    wbk.Sheets(2).Range("A1:A30").Copy
    rngDest.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
End Sub