Copy several cells form multiple workbooks into a new workbook.

[migces]

Hello,

I have many workbooks, each with only one worksheet, containing a wide range of data related to one candidate for a work position. I need to copy specific data from each candidate into a new workbook that will contain all the candidates so i can look in one place for all the relevent data for all candidates, rather than opening each individual candidate file.

For example:

I need to copy the cells D7,K10:K13,K16:K21,K24:K29,K34:K37 and K39, from each candidate workbook, into a row on the new unified workbook.

Hope it made sense.

Thx for any help.

Cheers

 

[mumps]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook, wkbSource As Workbook, desWS As Worksheet
    Set desWS = ThisWorkbook.Sheets("Work Candidates")
    Const strPath As String = "C:\workfiles\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            ActiveSheet.Range("D7").Copy
            desWS.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            ActiveSheet.Range("K10:K13,K16:K21,K24:K29,K34:K37,K39").Copy
            desWS.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True, Paste:=xlPasteValues
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[migces]

Thanks. That works great but i have discovered a new problem:

I've tested with different number of files on the source folder and i found out that the D7 value is the right one for the first file but the next values from the K column are from the next file......

As an example:

Say i have 2 files: candidate_A.xls and candidate_B.xls

When i run the macro what happens is that both candidates names are pasted right, but the candidate A receives the data from the candidate B file and candidate B receives no data, just blanks.

Seems that it opens the candidate A file --> copies the D7 value from it into A2 cell --> closes the file --> opens the candidate B file --> copies the values from the K range into the B2,C2,D2,E2, etc... cells.


Hope it made some sence....

Thx again

 

[mumps]

Are any of the D7 cells in any of the files blank?

 

[migces]

No, all the files have the D7 filled with the candidate name.

Here is a template of the source candidate file: https://ufile.io/06yeq

All the values are pasted correctly only if i have 1 file on the folder. As soon as i add another file, the above behaviour happens.

 

[migces]

No, all the files have the D7 filled with the candidate name.

Here is a template of the source candidate file: https://ufile.io/06yeq

All the values are pasted correctly only if i have 1 file on the folder. As soon as i add another file, the above behaviour happens.

Update:

A bit of testing and found out that by filling all the K cells with values, the macro works great. Problem is that most K cells are blank because there was no need to fill them per candidate evaluation.

Any way that if the cell is blank, just copy blank, or 0?

Thx.

 

[mumps]

See if this works for you:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook, wkbSource As Workbook, desWS As Worksheet, bottomA As Long
    Set desWS = ThisWorkbook.Sheets("Work Candidates")
    Const strPath As String = "C:\workfiles\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            ActiveSheet.Range("D7").Copy
            bottomA = desWS.Range("A" & desWS.Rows.Count).End(xlUp).Row + 1
            desWS.Cells(bottomA, 1).PasteSpecial xlPasteValues
            ActiveSheet.Range("K10:K13,K16:K21,K24:K29,K34:K37,K39").Copy
            desWS.Cells(bottomA, 2).PasteSpecial Transpose:=True, Paste:=xlPasteValues
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[migces]

That worked flawlessly!

Thx again for your help and patience.

Cheers

 

[mumps]

My pleasure.