VBA Code to Find a Value on a sheet and copy and paste the values below it

[LindenWolf]

I am very new at VBA and really need some help with a piece of VBA code.

I receive a file from someone that has a Heading (maybe in row 2, row 1, row 3, who knows) The heading labels are at least consistent.
I have a master template that I need to copy the data beneath each heading of their file to my file.

Received File: the value I am looking for is called Employee Name, could be in column G, H, I just depends on how inconsistent they are
Master Template File: My value is always in column G and I would need to post their data starting in cell G2

So I need to do a search on the Employee Name title so that I know where it is today, then copy the data underneath that all the way to the end and paste it in my Master Template File starting in Column G2.

Any help would be greatly appreciated.

 

[mumps]

Start by making sure that both files are open. Copy and paste the macro below into a regular module in your Master Template file. After pasting the macro, save the Master file as a macro-enabled file with an "xlsm" extension. Since you didn't mention actual file names or sheet names, you will have to change the file names and sheet names in the code to match yours. After all this is done, run the macro.

Sub Copydata()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Workbooks("ReceivedFile.xlsx").Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim foundVal As Range
    Set foundVal = Workbooks("ReceivedFile.xlsx").Sheets("Sheet1").UsedRange.Cells.Find("Employee Name", LookIn:=xlValues, lookat:=xlWhole)
    If Not foundVal Is Nothing Then
        Workbooks("ReceivedFile.xlsx").Sheets("Sheet1").Range(Cells(foundVal.Row + 1, foundVal.Column), Cells(LastRow, foundVal.Column)).Copy _
            Workbooks("MasterFile.xlsm").Sheets("Sheet1").Range("G2")
    End If
    Application.ScreenUpdating = True
End Sub

 

[LindenWolf]

Mumps, thank you so much for the code and the fast reply.

1 thing, when I used it, it copied the heading and only 1 cell below that.

How can I tweak it to not include the heading and copy all the way to the bottom. Other than that it is working like a champ.

 

[mumps]

The code should be copying the range starting one cell below the heading to the last row in that column. I think that it would be much easier to debug if I could see how your data is organized. Perhaps you could upload a copy of your "Received" file to a free site such as www.box.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the file contains confidential information, replace it with generic data.

 

[LindenWolf]

Sorry for the delay, had to go to lunch..

So the Received File is: https://app.box.com/s/2c4dbuvvoqbb9ne6bbwaz8xqc0jcy201

The Template File is: https://app.box.com/s/jveczpys93e7ath0bx7lxha66bo6y1dx

Thanks again for the help..

 

[LindenWolf]

Also, is it possible to PasteSpecial Values when pasting. I noticed in my trial a color got moved over as well, so just trying to avoid moving formulas or anything like that.

 

[LindenWolf]

I figured out the Copy Paste Special Values thing.

 

[LindenWolf]

So trying to dig into the code some more. by Putting the second +1 got rid of the header.

Workbooks("ReceivedFile.xlsx").Sheets("Sheet1").Range(Cells(foundVal.Row + 1, foundVal.Column), Cells(LastRow +1, foundVal.Column)).Copy

The only thing now is that it is only going down by that count. So if I put 1000 it will copy 1000 records down that same column vs. just going to the end.

 

[mumps]

This macro works perfectly on the files you posted. Make sure the Master workbook is the active workbook when you run the macro.

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Workbooks("Master_Data.xlsx").Sheets("Master_Data").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim foundVal As Range
    Set foundVal = Workbooks("Master_Data.xlsx").Sheets("Master_Data").UsedRange.Cells.Find("Employee Name", LookIn:=xlValues, lookat:=xlWhole)
    If Not foundVal Is Nothing Then
        Workbooks("Master_Data.xlsx").Sheets("Master_Data").Range(Cells(foundVal.Row + 1, foundVal.Column), Cells(LastRow, foundVal.Column)).Copy
            Workbooks("Template.xlsm").Sheets("Sheet1").Range("G2").PasteSpecial xlPasteValues
    End If
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

By the way, we can speed up the macro if you know that "Employee Name" will always be on row 2 of the Master file.

 

[LindenWolf]

Thank you Mumps.

For some reason it still wants to just copy the header and 1 row of code. It's pretty crazy. By adding a variable on the last Cells(lastrow + 4000,foundval.column)) section I was able to at least eliminate the header and grab 4000 rows of data. Obviously not the best use but my excel apparently is not happy with me at the moment.

The code works great, you have definetly put me in a much better place than I was before. You have truly answered my question and I thank you for that.

Being new to VBA I have a side question as it relates to the code. My head explodes as to how it knows where to start and where to go down from does the following code basically tell it. Start here and go down the column, stop and then copy? I just want to get better at writing in VBA.

Workbooks("Master_Data.xlsx").Sheets("Master_Data")._'===========> Does this say you are in this WorkBook and WOrksheet
Range(Cells(foundVal.Row + 1, foundVal.Column), Cells(LastRow, foundVal.Column))_'===========> You are start in cell (i.e. G2) but need to go down to G3 to the end of the Colwhere the last data is
.Copy '===========> Copy it

Is that pretty much how the code is working