VBA Code to copy data from (specific sheet) in multiple workbooks and paste rows with content to Master Workbook

[clutcher]

The goal is to: write a VBA Code to copy data from (specific sheet) in multiple workbooks and paste rows with content to Master Workbook. I have spent the last few days working on this, but I was really excited to come across this site.

Current, when the information desired is copied, I noticed that it does not paste it within the table I created (using CTL + T), the copied items are displayed at the bottom of the table (1 to 100). For example, if I instruct it to copy and paste it starting on the 5th row on the table, it was pasting the information on line 101 (which is the end of the table i created).
I used 'erow = sheet3.cells(Rows.Count,3).End(xlUp).End(xlUp).Offset(1,0).Row (i.e. with End(xlUp) twice, but this appears to paste the information within the table correctly but does not copy all the rows and paste all the rows from each file.

Below is the code being used, please share your thoughts with me:


"Dim MyFile as String
Dim erow
Dim x as workbook
dim y as workbook
.
.
.
Set x = workbooks.open(MyFile)
set y = Thisworkbook
x.activate
x.sheets("sheet3").Range(C5:AN5).copy
y.activate
erow = sheet3.cells(Rows.Count,3).End(xlUp).Offset(1,0).Row
Activesheet.Paste Destination:=Worksheets("sheet3").Range(Cells(erow,3),cells(erow, 41))
x.close
MyFile = Dir
Loop
End Sub"


The other questions I have are:
a) Is there way to copy the files without opening those files on my computer screen?
b) Is there way to prevent it copying a row/file more than once?
Would greatly appreciate your input.
I owe a lifetime of gratitude to whoever is willing to assist with this.

Note: The Titles and rows are consistent in each of the workbook and the name of the specific sheet I want to copy from is the same in each workbook ....and the name if the sheet being pasted to in the master workbook is the same as well.
Both the workbooks being copied from and pasted master worksheet pasted to ...are password protected.

 

[mumps]

I have a macro for you to try. It makes the following assumptions:
-You want to copy all rows in the source sheets that haven't already been copied to the Master file.
-Each source sheet has a unique value in each row with data in column AM.
-The folder path is correct.

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wsDest As Worksheet, wsSource As Worksheet, wkbSource As Workbook
    Set wsDest = ThisWorkbook.Sheets("DataAnalysis")
    Dim LastRow As Long, ID As Range, foundID As Range
    Const strPath As String = "C:\MyComputer\Documents\Analysis\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        Set wsSource = Sheets("DataAnalysis")
        LastRow = wsSource.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        For Each ID In wsSource.Range("AM5:AM" & LastRow)
            Set foundID = wsDest.Range("AM:AM").Find(ID, LookIn:=xlValues, lookat:=xlWhole)
            If foundID Is Nothing Then
                wsSource.Range("C" & ID.Row & ":AN" & ID.Row).Copy wsDest.Cells(wsDest.Rows.Count, "C").End(xlUp).Offset(1, 0)
            End If
        Next ID
        wkbSource.Close savechanges:=False
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Give this a try and see how it works out.

 

[clutcher]

I would like to always copy Range(C5:AN5) each time from the source file and paste to range (C5:AN5) in the destination file.

 

[clutcher]

Just saw your code, going to try it and get back to you. Might not be able to validate till tomorrow morning. You're incredible!! Thank you so much

 

[clutcher]

Mumps, you are a MAGICIAN indeed!!! I ran to work today (Sunday) just to test out the code. It worked like magic, the only thing I added were password. Super super impressed. You deserve a GOLDEN award. I truly cannot thank you enough

 

[mumps]

You are very welcome. I'm glad it worked out and thank you for the kind words.

 

[clutcher]

I have one last request. It’s working great but it’s not pasting in the desired format. Each of the cells in the destination sheet is formatted to automatically assume a conditional format or display as a drop down when the cell is selected.

The previous code which has pastespecial _ Paste:=xlPasteValuesAndNumberFornat solves this problem. Can you share a recommendation to this problem?

 

[mumps]

Try replacing this part of the code:

If foundID Is Nothing Then
                wsSource.Range("C" & ID.Row & ":AN" & ID.Row).Copy wsDest.Cells(wsDest.Rows.Count, "C").End(xlUp).Offset(1, 0)
            End If

with this:

 If foundID Is Nothing Then
                wsSource.Range("C" & ID.Row & ":AN" & ID.Row).Copy
                wsDest.Cells(wsDest.Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
            End If

 

[clutcher]

Mumps, thanks again in advance!! I tried the code but I was getting error message (runtime error '438). When I tried to troubleshoot, it was pointing to this link in the program " wsDest.Cells(wsDest.Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats". Please let me know what I might have got wrong.

 

[mumps]

I put together a couple of dummy files to test the macro below and it worked properly without any errors. It is difficult for me to find the cause of any error unless I can reproduce the error. Unfortunately, I don't have access to your files to see what is causing the error. Perhaps you could upload a copy of one of the source files and destination file (files that are causing the error) to a free site such as www.box.com or www.dropbox.com. Once you do that, mark each file for 'Sharing' and you will be given a link to each file that you can post here. If the workbooks contains confidential information, you could replace it with generic data.

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wsDest As Worksheet, wsSource As Worksheet, wkbSource As Workbook
    Set wsDest = ThisWorkbook.Sheets("DataAnalysis")
    Dim LastRow As Long, ID As Range, foundID As Range
    Const strPath As String = "C:\MyComputer\Documents\Analysis\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        Set wsSource = Sheets("DataAnalysis")
        LastRow = wsSource.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        For Each ID In wsSource.Range("AM5:AM" & LastRow)
            Set foundID = wsDest.Range("AM:AM").Find(ID, LookIn:=xlValues, lookat:=xlWhole)
            If foundID Is Nothing Then
                wsSource.Range("C" & ID.Row & ":AN" & ID.Row).Copy
                wsDest.Cells(wsDest.Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
            End If
        Next ID
        wkbSource.Close savechanges:=False
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[clutcher]

Mumps, a few minor clarifications:
a) I started getting an error message after and updated the worksheets changed the names. The message says "This workbook contain links to one or more external sources that could be unsafe. If you trust the link, update them to get the latest data. Otherwise, you can keep working with the data you have."

Is they are way to resolve this? I clicked on it but the source was trying to point to old files I have deleted or renamed.

b) The paste function is still presenting some challenges. Is there another way to write such that it would copy (source format and attributes) and paste it? I noticed that the you sent shows a space between "PasteSpecial" and "xlPasteValues....", when I entered it, the system generate an error if there's space, but when I keep the code as "PasteSpecialxlPasteValues...." it doesn't seem to work.

c) Lastly, it's the program is running a little slower now. I suspect it's because error in (a)

True believer in your magic and I wish I could make it easier by sharing the file with you. I don't even have access to the file on my personal computer and it will take a long time to recreate a template. What is your box email? Let me see if can create something entirely different but similar. If you have a potential solution I can try now, that would be fantastic.