You are here:

Excel/Macro to Cut and Paste from other sheet

Advertisement


Question
I have two sheets. The content of sheet 1 looks like this.

EmpID   FName   CaseID   Count Case
416   Lorna   602172   12
412   Shaine   603107   6
654   Alice   603152   45
361   Roman   603082   23
412   Shaine   603118   45

and my second sheet looks like this.

EmpID   FName   CaseID   Count Case
416   Lorna   602172   23
412   Shaine   603107   42
654   Alice   691152   13

I need a macro that will match the Emp ID and Case ID on both sheets. If found, the macro should CUT from Sheet 2 and paste in the next blank row of sheet 1, so for the example above, after running the macro the table on sheet 1 should look like this.

EmpID   FName   caseID   Count Case
416   Lorna   602172   12
412   Shaine   603107   6
654   Alice   603152   45
361   Roman    603082   23
412   Shaine   603118   45
412   Shaine   603107   42
416   Lorna   602172   23

And table on sheet2 should look like this.

EmpD   FName   CaseID   Count Case
654   Alice   691152   13

Last 2 rows on sheet on sheet1 and was removed in sheet 2 because they are a duplicate of the first 2 rows of sheet1.

I am really hoping you can help me with this.

Thank you in advance.

Answer
PJ,

I assumed that you data is as you show and that in each sheet, the word EmpID is in A1 (to establish where the data is).  I copied you data nd placed it such in a workbook with your first data in Sheet1 and your second set of Data in Sheet2.  I then ran the below code and in sheet1 it produced

EmpID   FName   CaseID   Count Case
416   Lorna   602172   12
412   Shaine   603107   6
654   Alice   603152   45
361   Roman   603082   23
412   Shaine   603118   45
416   Lorna   602172   23
412   Shaine   603107   42

and in sheet2 it finished with

EmpID   FName   CaseID   Count Case
654   Alice   691152   13


here is my code that did that:


Sub ABC()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim r1 As Range, r2 As Range, r2e As Range, r2eRow As Range
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
Set r2 = sh2.Range("A2", sh2.Cells(sh2.Rows.Count, 1).End(xlUp))
Set r1 = sh1.Range("A2", sh1.Cells(sh1.Rows.Count, 1).End(xlUp))
r2.Offset(0, 4).Formula = "=if(Countifs(" & r1.Address(1, 1, xlA1, True) & "," & _
 "A2," & r1.Offset(0, 2).Address(1, 1, xlA1, True) & ",C2)>0,na(),"""")"
On Error Resume Next
Set r2e = r2.Offset(0, 4).SpecialCells(xlFormulas, xlErrors)
On Error GoTo 0
If Not r2e Is Nothing Then
 Set r2eRow = r2e.EntireRow
 Set r2eRow = Intersect(r2eRow, sh2.Range("A:D").EntireColumn)
 r2eRow.Copy r1(r1.Count).Offset(1, 0)
 r2eRow.EntireRow.Delete
End If
sh2.Columns(5).Delete
End Sub

If the layout of your data does not match what I have stated above, then modify the code to handle data the way you have it laid out/match your sheet names and so forth.          

--
Regards,
Tom Ogilvy  
About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Tom Ogilvy

Expertise

Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]

Experience

Extensive experience.

Education/Credentials
Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2016 About.com. All rights reserved.