excel macro copy paste from multiple workbooks to end o data sheet

Question

I am trying to go into a folder, open each file, copy the data from a certain sheet "Record", paste that data to the file the macro is in on the "Data" tab. The data should add, so each files data should show up. I am having the trouble getting the data to paste to the end and not a specific cell each time. I have tried using a variable to be the last row and offset it, but the paste is just not working and keeps throwing errors. I'm desperate for help! I've been searching blogs for hours upon hours. You can see the code I have below:

Sub copyMultFilesv2()
    Dim rS As Range, rT As Range, Cel As Range
    Dim wBs As Workbook 'source workbook
    Dim wS As Worksheet 'source sheet
    Dim wT As Worksheet 'target sheet
    Dim x As Long 'counter
    Dim c As String
    Dim arrFiles() As String 'list of source files
    Dim myFile As String 'source file
    Dim RowLast As Long
    Dim csTRng As Range
    Dim csSRng As Range
    Dim lastrow As Long
    Dim datatocopy As Range
    Dim opencell As Range

    '    change these to suit requirements
    Const csMyPath As String = "C:\Users\Whatley Macie\Desktop\TestTWC\" 'source folder
    Const csMyFile As String = "*.xl*" 'source search pattern
    'Set csSRng = Worksheets("Record").Range("A2:Z" & Range("A1").End(xlDown).Row) 'source range
'    Set csTRng = Worksheets("Data").Range("A1").End(xlDown).Offset(1, 0) 'target range make is the end of target

    Application.ScreenUpdating = False
    '   target sheet
    Set wT = ThisWorkbook.Worksheets("Data") 'change to suit

'   aquire list of files
    ReDim arrFiles(1 To 1)
    myFile = Dir$(csMyPath & csMyFile, vbNormal)
    Do While Len(myFile) > 0
        arrFiles(UBound(arrFiles)) = myFile
        ReDim Preserve arrFiles(1 To UBound(arrFiles) + 1)
        myFile = Dir$
    Loop
    ReDim Preserve arrFiles(1 To UBound(arrFiles) - 1)

    Set rT = wT.Range("A" & Rows.count).End(xlUp).Offset(1)

    'c = wT.UsedRange.Rows.count
    'csTRng

    ' loop thru list of files
    For x = 1 To UBound(arrFiles)
        Set wBs = Workbooks.Open(csMyPath & arrFiles(x), False, True) 'open wbook
        Set wS = wBs.Worksheets("Record") 'change sheet to suit


        'datatocopy = wS.Range("A2:Z" & Range("A1").End(xlDown).row).Select
        'datatocopy.PasteSpecial 'xlPasteAll
        Application.CutCopyMode = False

        'opencell = ("A" & c)
        c = ActiveSheet.UsedRange.Rows.count
        'Copy the data
        'wS.Range("A2:Z" & Range("A1").End(xlDown).row).Value = wT.Range("A2").Offset(c).Value
        wS.Range("A2:Z" & Range("A1").End(xlDown).row).Copy
        'wT.Range("A2").Value = wS.Range("A2:Z100").Value
        'Sheets("").Range("A1:B10").Copy
        'Activate the destination worksheet
        wT.Activate
        'Select the target range

        'ActiveCell(c + 1, 1).PasteSpecial xlPasteValues
        Dim target As Range
        Set target = Cells((c + 1), 1)
        'Range("A2").Offset(c, 0).Select
        target.Select
        'Range("A2").Offset(RowOffset:=c).Select

        'Paste in the target destination
        'ActiveCell.Offset (c)
        target.Paste

        Application.CutCopyMode = False
        'rT.Offset(1,0)

        wBs.Close False
        'Set rT = rT.Offset(1) 'next row
        DoEvents

    Next x 'next book

    Erase arrFiles

    Application.ScreenUpdating = True

End Sub

What exact error message are you getting (and can you confirm it's on the `target.Paste` line)? Also, take a look at [this question](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) for how to avoid using `select` and `Activate`. It's possible that tidying up your code in that way will fix your errors (as well as making it more robust and readable). — aucuparia, Jul 24 '14 at 06:53

score 0 · Answer 1 · edited Aug 29 '14 at 07:21

I have two solutions:(also you may want to turn on screen updating while you are working on this)

Select the sheet first to be pasted and then select the cell you want to paste to.
Use an Array (your code will run faster) this is untested so check my spelling.

.

Dim arraySource as variant 'somewhere in the start
'Note: c should be saved as a long not a string
arraySource = wS.Range("A2:Z" & Range("A1").End(xlDown).row)
' populate your array instead of wS.Range("A2:Z" & Range("A1").End(xlDown).row).Copy
wt.range("A" & c : "A" & (c + ubound(arraySource)) = arraySource

Once again untested but give it a try.

excel macro copy paste from multiple workbooks to end o data sheet

1 Answers1