VBA - Copy specific columns from sheet2 into sheet1 within the same Workbook

J

JTS25

New Member
Joined
Oct 10, 2019
Messages
31
Hi all,

I have been working on the VBA for a little while now, and have figured it out. There are default headers, and the macro data starts on row2 for everything.

Columns
Sheet1=DestinationABCFILPSV
Sheet2=SourceDECJRSAAACAI

<tbody>
</tbody>

I'm wondering if there is an easier or more desirable way to write this VBA? Below is what I have done so far that works, but it does take a while to run.

I've seen some other people asking for similar advice, and the VBA that I have seen from mumps and other pros looks different.

Code: 
Sub copycol()
Dim lastrow As Long, erow As Long


Application.ScreenUpdating = False




'to check the last filled line on sheet named CMF DB
lastrow = Worksheets("CMF DB").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow






Worksheets("CMF DB").Cells(i, 4).Copy


' How many Rows are already filled
erow = Worksheets("Recon Master").Cells(Rows.Count, 1).End(xlUp).Row


Worksheets("CMF DB").Paste Destination:=Worksheets("Recon Master").Cells(erow + 1, 1)


Worksheets("CMF DB").Cells(i, 5).Copy
Worksheets("CMF DB").Paste Destination:=Worksheets("Recon Master").Cells(erow + 1, 2)


Worksheets("CMF DB").Cells(i, 3).Copy
Worksheets("CMF DB").Paste Destination:=Worksheets("Recon Master").Cells(erow + 1, 3)


Worksheets("CMF DB").Cells(i, 10).Copy
Worksheets("CMF DB").Paste Destination:=Worksheets("Recon Master").Cells(erow + 1, 6)


Worksheets("CMF DB").Cells(i, 18).Copy
Worksheets("CMF DB").Paste Destination:=Worksheets("Recon Master").Cells(erow + 1, 9)


Worksheets("CMF DB").Cells(i, 19).Copy
Worksheets("CMF DB").Paste Destination:=Worksheets("Recon Master").Cells(erow + 1, 12)


Worksheets("CMF DB").Cells(i, 27).Copy
Worksheets("CMF DB").Paste Destination:=Worksheets("Recon Master").Cells(erow + 1, 16)


Worksheets("CMF DB").Cells(i, 29).Copy
Worksheets("CMF DB").Paste Destination:=Worksheets("Recon Master").Cells(erow + 1, 19)


Worksheets("CMF DB").Cells(i, 35).Copy
Worksheets("CMF DB").Paste Destination:=Worksheets("Recon Master").Cells(erow + 1, 22)


Next i


Application.ScreenUpdating = True


End Sub
 
Sort by date Sort by votes
Thanks Mark and Mumps, really appreciate it.

If I'm wanting to add a vLookup to this code, where it would look for values with in source sheet 3(CMS) and would be placed in destination sheet (Recon Master) based on unique values in column 'C' within destination sheet (Recon Master). Is this the way you would do it:
<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">
Sub copycol()
Application.ScreenUpdating = False
Dim lastRow As Long, srcWS As Worksheet, srcWS as Worksheet, desWS As Worksheet
Set srcWS = Sheets("CMF DB")
Set srcWS = Sheets("CMS")
Set desWS = Sheets("Recon Master")
lastRow = srcWS.Cells(Rows.Count, 1).End(xlUp).Row
With scrws
.Range("D2:D" & lastRow).Copy desWS.Range("A2")
.Range("E2:E" & lastRow).Copy desWS.Range("B2")
.Range("C2:C" & lastRow).Copy desWS.Range("C2")
.Range("J2:J" & lastRow).Copy desWS.Range("F2")
.Range("R2:R" & lastRow).Copy desWS.Range("I2")
.Range("S2:S" & lastRow).Copy desWS.Range("L2")
.Range("AA2:AA" & lastRow).Copy desWS.Range("P2")
.Range("AC2:AC" & lastRow).Copy desWS.Range("S2")
.Range("AI2:AI" & lastRow).Copy desWS.Range("V2")
End With

With srcWS
Lastrow = .Cells(rows.count, "x").end(xlup).row
.Range("D2:D" & lastrow) = "vlookup(C2,CMS!A:D,4,false)"
End With

Application.ScreenUpdating = True
End Sub
</code></pre>
 
Upvote 0

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Can you explain in words what you are trying to do with the vlookup formula? Refer to specific cells, rows, columns and sheets using a few examples from your data. Also, replace "With scrws" with "With srcWS". When posting code, please use code tags. Select the code to highlight it and then click the # sign in the menu.
 
Upvote 0
mumps said:
Can you explain in words what you are trying to do with the vlookup formula? Refer to specific cells, rows, columns and sheets using a few examples from your data. Also, replace "With scrws" with "With srcWS". When posting code, please use code tags. Select the code to highlight it and then click the # sign in the menu.
Click to expand...

Sure thing Mumps, sorry for not providing enough detail.

There is a third sheet within this workbook called (CMS). After the copy code is executed between sheets 'Recon Master' & (CMF D)", I would like a code to be executed for a vLookup.

the Destination sheet is still (Recon Master) and Column 'C' would have the unique values, that would be used to find the values needed from sheet (CMS). The values would start in row 2 of each column in the destination sheet, and flow down. Below is a breakout of what I'm looking to do:

Based on 'Column C' in Recon Sheet
Destination Sheet (Recon Master)D2E2H2K2O2R2
Source Sheet (CMS)B:CB:EB:GB:HB:LB:M

<colgroup><col><col span="7"></colgroup><tbody>
</tbody>


Original Code:
Code: 
Sub copycol()
    Application.ScreenUpdating = False
    Dim lastRow As Long, srcWS As Worksheet, desWS As Worksheet
    Set srcWS = Sheets("CMF DB")
    Set desWS = Sheets("Recon Master")
    lastRow = srcWS.Cells(Rows.Count, 1).End(xlUp).Row
    With srcWS
        .Range("D2:D" & lastRow).Copy desWS.Range("A2")
        .Range("E2:E" & lastRow).Copy desWS.Range("B2")
        .Range("C2:C" & lastRow).Copy desWS.Range("C2")
        .Range("J2:J" & lastRow).Copy desWS.Range("F2")
        .Range("R2:R" & lastRow).Copy desWS.Range("I2")
        .Range("S2:S" & lastRow).Copy desWS.Range("L2")
        .Range("AA2:AA" & lastRow).Copy desWS.Range("P2")
        .Range("AC2:AC" & lastRow).Copy desWS.Range("S2")
        .Range("AI2:AI" & lastRow).Copy desWS.Range("V2")
    End With
    Application.ScreenUpdating = True
End Sub

Updated Code: I've bolded/Italics the new items I've added. Also, should I need to call out the desWS in the new code?
Code: 
[COLOR=#303336][FONT=Consolas]Sub copycol()[/FONT][/COLOR]
[COLOR=#303336][FONT=Consolas]Application.ScreenUpdating = False[/FONT][/COLOR]
[COLOR=#303336][FONT=Consolas]Dim lastRow As Long, srcWS As Worksheet, [I][B]srcWS as Worksheet[/B][/I], desWS As Worksheet[/FONT][/COLOR]
[COLOR=#303336][FONT=Consolas]Set srcWS = Sheets("CMF DB")[/FONT][/COLOR]
[I][B][COLOR=#303336][FONT=Consolas]Set srcWS = Sheets("CMS")[/FONT][/COLOR][/B][/I]
[COLOR=#303336][FONT=Consolas]Set desWS = Sheets("Recon Master")[/FONT][/COLOR]
[COLOR=#303336][FONT=Consolas]lastRow = srcWS.Cells(Rows.Count, 1).End(xlUp).Row[/FONT][/COLOR]
[COLOR=#303336][FONT=Consolas]With scrws[/FONT][/COLOR]
[COLOR=#303336][FONT=Consolas].Range("D2:D" & lastRow).Copy desWS.Range("A2")[/FONT][/COLOR]
[COLOR=#303336][FONT=Consolas].Range("E2:E" & lastRow).Copy desWS.Range("B2")[/FONT][/COLOR]
[COLOR=#303336][FONT=Consolas].Range("C2:C" & lastRow).Copy desWS.Range("C2")[/FONT][/COLOR]
[COLOR=#303336][FONT=Consolas].Range("J2:J" & lastRow).Copy desWS.Range("F2")[/FONT][/COLOR]
[COLOR=#303336][FONT=Consolas].Range("R2:R" & lastRow).Copy desWS.Range("I2")[/FONT][/COLOR]
[COLOR=#303336][FONT=Consolas].Range("S2:S" & lastRow).Copy desWS.Range("L2")[/FONT][/COLOR]
[COLOR=#303336][FONT=Consolas].Range("AA2:AA" & lastRow).Copy desWS.Range("P2")[/FONT][/COLOR]
[COLOR=#303336][FONT=Consolas].Range("AC2:AC" & lastRow).Copy desWS.Range("S2")[/FONT][/COLOR]
[COLOR=#303336][FONT=Consolas].Range("AI2:AI" & lastRow).Copy desWS.Range("V2")[/FONT][/COLOR]
[COLOR=#303336][FONT=Consolas]End With[/FONT][/COLOR]

[I][B][COLOR=#303336][FONT=Consolas]With srcWS[/FONT][/COLOR]
[COLOR=#303336][FONT=Consolas]Lastrow = .Cells(rows.count, "x").end(xlup).row[/FONT][/COLOR]
[COLOR=#303336][FONT=Consolas].Range("D2:D" & lastrow) = "vlookup(C2,CMS!B:C,2,false)"[/FONT][/COLOR]
[COLOR=#303336][FONT=Consolas]End With[/FONT][/COLOR][/B][/I]

[COLOR=#303336][FONT=Consolas]Application.ScreenUpdating = True[/FONT][/COLOR]
[COLOR=#303336][FONT=Consolas]End Sub[/FONT][/COLOR]

I also found a thread, that is asking for something similar that I'm looking for. Below is what someone posted. I'm not sure if this would work or not:
Code: 
Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Target.Address(0, 0) = "C2" Then
    Dim sh3 As Worksheet, f As Range
    Set sh3 = Sheets("CMS")
    Set f = sh3.Range("A:M").Find(Range("C2"), , xlValues, xlWhole)
    If Not f Is Nothing Then
      Range("E2") = sh3.Range("D" & f.Row)
    Else
      MsgBox "name does not exist"
    End If
  End If
End Sub
 
Upvote 0
Still a bit confused. This is my interpretation of what you want to do with this line of code:
Code: 
.Range("D2:D" & lastrow) = "vlookup(C2,CMS!A:D,4,false)"

You want to find the value in column C of "Recon Master" in column A of the "CMS" sheet. If found, you want to return the corresponding value in column D of the "CMS" sheet to column D of "Recon Master". Is this correct? If not, please upload a copy of your two files 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. Include a detailed explanation of what you would like to do referring to specific cells, rows, columns and worksheets. If the workbook contains confidential information, you could replace it with generic data.
 
Upvote 0
First of all this
Code: 
With scrws
is still wrong and I can't see how it would run without erring until it is corrected. It should be
Code: 
s[COLOR="#FF0000"]rc[/COLOR]WS

In this line the colored bits are declared twice which serves no purpose
Code: 
Dim lastRow As Long, [COLOR="#FF0000"]srcWS As Worksheet[/COLOR], [COLOR="#0000FF"]srcWS as Worksheet[/COLOR], desWS As Worksheet

In the below you are setting 2 different worksheets to the same variable which means that only the 2nd one is valid, they need to be assigned to separate variables.

Code: 
Set srcWS = Sheets("CMF DB")
Set srcWS = Sheets("CMS")

Other than that see post number 15 by mumps and follow the instructions given so we can have a better idea of your requirements.
 
Last edited:
Upvote 0
mumps said:
Still a bit confused. This is my interpretation of what you want to do with this line of code:
Code: 
.Range("D2:D" & lastrow) = "vlookup(C2,CMS!A:D,4,false)"

You want to find the value in column C of "Recon Master" in column A of the "CMS" sheet. If found, you want to return the corresponding value in column D of the "CMS" sheet to column D of "Recon Master". Is this correct? If not, please upload a copy of your two files 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. Include a detailed explanation of what you would like to do referring to specific cells, rows, columns and worksheets. If the workbook contains confidential information, you could replace it with generic data.
Click to expand...

So the workbook that we have been working on has three sheets 'Recon Master', 'CMF DB', 'CMS'

There are headers in Rows 1 for all of the columns in each sheet. Rows 2 is where the data starts.

I use sheet 'Recon Master' to use vlookup formulas to return matching values from sheet ' CMS' to certain columns in sheet 'Recon Master'.

Column 'C' on the sheet 'Recon Master' has identifiers like '1901 INIT1022', that triggers the vLookup to return matching values from specific columns in sheet 'CMS' back to sheet 'Recon Master'.

Cell 'D2' in sheet 'Recon Master' would get it's value from column 'C' in sheet 'CMS'. Normally I would use =vlookup(C2,'Recon Master'!B:C,2,FALSE) to find the values for column 'D' in sheet 'Recon Master'.
Cell 'E2' in sheet 'Recon Master' would get it's value from column 'E' in sheet 'CMS'
Cell 'H2' in sheet 'Recon Master' would get it's value form column 'G' in sheet 'CMS'... and so on

These sheets have around 700 rows each.

Sheet 'Recon Master'
ABCDEFGH
PROJ_IDContract_NumberCust_Proj_NumAgreement_NumberContract_TypeSubcontractor_Cons_NameStatusPOP_Start_Contracts
1221901 INIT1000Value from Sheet 'CMS'Value from Sheet 'CMS'Joes PlaceAValue from Sheet 'CMS'
2551902 INIT1000ApplebeesA
3441903 INIT1000Gas StationA
4881904 INIT1000ectA
5991905 INIT1000ectA

<tbody>
</tbody>

Sheet 'CMS'
ABCDEFG
Contract_NumberCust_Proj_NumAgreement_NumberContract_TypeSubcontractor_Cons_NameStatusPOP_Start
2222221901 INIT 10002009-371-007Firm Fixed Price (FFP)Joes placeA19-Jan-12
33331905 INIT10002010-361-006Cost Plus Fixed Fee (CPFF)ectA28-Mar-12
55551903 INIT 10002010-361-007Cost Plus Fixed Fee (CPFF)Gas StationA09-Apr-12
4441904 INIT 10002009-602-005Cost Plus Fixed Fee (CPFF)ectA15-Mar-12
8881902 INIT 10002010-309-002Firm Fixed Price (FFP)ApplebeesA14-Mar-12

<tbody>
</tbody>

I hope this helps.
 
Upvote 0
Try:
Code: 
Sub copycol()
    Application.ScreenUpdating = False
    Dim lastRow As Long, srcWS1 As Worksheet, srcWS2 As Worksheet, desWS As Worksheet, projNum As Range, fnd As Range
    Set srcWS1 = Sheets("CMF DB")
    Set srcWS2 = Sheets("CMS")
    Set desWS = Sheets("Recon Master")
    lastRow = srcWS1.Cells(Rows.Count, 1).End(xlUp).Row
    With srcWS1
        .Range("D2:D" & lastRow).Copy desWS.Range("A2")
        .Range("E2:E" & lastRow).Copy desWS.Range("B2")
        .Range("C2:C" & lastRow).Copy desWS.Range("C2")
        .Range("J2:J" & lastRow).Copy desWS.Range("F2")
        .Range("R2:R" & lastRow).Copy desWS.Range("I2")
        .Range("S2:S" & lastRow).Copy desWS.Range("L2")
        .Range("AA2:AA" & lastRow).Copy desWS.Range("P2")
        .Range("AC2:AC" & lastRow).Copy desWS.Range("S2")
        .Range("AI2:AI" & lastRow).Copy desWS.Range("V2")
    End With
    lastRow = desWS.Cells(Rows.Count, 1).End(xlUp).Row
    For Each projNum In desWS.Range("C2:C" & lastRow)
        Set fnd = srcWS2.Range("B:B").Find(projNum, LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            projNum.Offset(, 1) = fnd.Offset(, 1)
            projNum.Offset(, 2) = fnd.Offset(, 2)
            projNum.Offset(, 5) = fnd.Offset(, 5)
        End If
    Next projNum
    Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
mumps said:
Try:
Code: 
Sub copycol()
    Application.ScreenUpdating = False
    Dim lastRow As Long, srcWS1 As Worksheet, srcWS2 As Worksheet, desWS As Worksheet, projNum As Range, fnd As Range
    Set srcWS1 = Sheets("CMF DB")
    Set srcWS2 = Sheets("CMS")
    Set desWS = Sheets("Recon Master")
    lastRow = srcWS1.Cells(Rows.Count, 1).End(xlUp).Row
    With srcWS1
        .Range("D2:D" & lastRow).Copy desWS.Range("A2")
        .Range("E2:E" & lastRow).Copy desWS.Range("B2")
        .Range("C2:C" & lastRow).Copy desWS.Range("C2")
        .Range("J2:J" & lastRow).Copy desWS.Range("F2")
        .Range("R2:R" & lastRow).Copy desWS.Range("I2")
        .Range("S2:S" & lastRow).Copy desWS.Range("L2")
        .Range("AA2:AA" & lastRow).Copy desWS.Range("P2")
        .Range("AC2:AC" & lastRow).Copy desWS.Range("S2")
        .Range("AI2:AI" & lastRow).Copy desWS.Range("V2")
    End With
    lastRow = desWS.Cells(Rows.Count, 1).End(xlUp).Row
    For Each projNum In desWS.Range("C2:C" & lastRow)
        Set fnd = srcWS2.Range("B:B").Find(projNum, LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            projNum.Offset(, 1) = fnd.Offset(, 1)
            projNum.Offset(, 2) = fnd.Offset(, 2)
            projNum.Offset(, 5) = fnd.Offset(, 5)
        End If
    Next projNum
    Application.ScreenUpdating = True
End Sub
Click to expand...

Mumps, this is perfect. Thank you very much, I think I can fill in the rest of it for the other columns in my desWS and get the code to work.

Mark -- Thank you as well for your assistance, i really do appreciate it.
 
Upvote 0
You are very welcome. :) Below is the code with explanatory notes. I hope this helps.
Code: 
Sub copycol()
    Application.ScreenUpdating = False
    Dim lastRow As Long, srcWS1 As Worksheet, srcWS2 As Worksheet, desWS As Worksheet, projNum As Range, fnd As Range
    Set srcWS1 = Sheets("CMF DB")
    Set srcWS2 = Sheets("CMS")
    Set desWS = Sheets("Recon Master")
    lastRow = srcWS1.Cells(Rows.Count, 1).End(xlUp).Row
    With srcWS1
        .Range("D2:D" & lastRow).Copy desWS.Range("A2")
        .Range("E2:E" & lastRow).Copy desWS.Range("B2")
        .Range("C2:C" & lastRow).Copy desWS.Range("C2")
        .Range("J2:J" & lastRow).Copy desWS.Range("F2")
        .Range("R2:R" & lastRow).Copy desWS.Range("I2")
        .Range("S2:S" & lastRow).Copy desWS.Range("L2")
        .Range("AA2:AA" & lastRow).Copy desWS.Range("P2")
        .Range("AC2:AC" & lastRow).Copy desWS.Range("S2")
        .Range("AI2:AI" & lastRow).Copy desWS.Range("V2")
    End With
    lastRow = desWS.Cells(Rows.Count, 1).End(xlUp).Row 're-sets the 'lastRow' variable to the last used row in the destination sheet
    For Each projNum In desWS.Range("C2:C" & lastRow) ' loops through all the number projects in column C of Recon Master
        Set fnd = srcWS2.Range("B:B").Find(projNum, LookIn:=xlValues, lookat:=xlWhole) 'searches column B in CMS for the project number
        If Not fnd Is Nothing Then 'if the project number is found, executes the following lines of code
            projNum.Offset(, 1) = fnd.Offset(, 1) 'the cell one column to the right of the project number in column B of CMS is place in the cell one column to the right of the project number in column C of Recon Master
            projNum.Offset(, 2) = fnd.Offset(, 2) 'same as above except the column is offset by 2
            projNum.Offset(, 5) = fnd.Offset(, 5) 'same as above except the column is offset by 5
        End If
    Next projNum
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Help with VBA Code
Replies
2
Views
152
joyrichter
J
J
  • Solved
Code to copy over row if certain criteria is met
2
Replies
18
Views
551
mumps
mumps
I
  • Solved
Copy and Paste from One workbook to another
Replies
3
Views
424
ipon70
I
S
  • Question
VBA macro if criteria is met copy cells to another worksheet
Replies
8
Views
547
slohman
S
Keebler
  • Solved
new project: copy range without empty or blank rows
5 6 7
Replies
68
Views
1K
Keebler
Keebler

Forum statistics

Threads
1,214,432
Messages
6,119,468
Members
448,900
Latest member
Fairooza

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top