PDA

View Full Version : Excel Macro Help



thepartydj
02-08-2007, 07:52 AM
I have one workbook ("WB1") with two worksheets (Sheet1 & Sheet2). Each worksheet has most of the same information, and I want to create a macro that will cobine each worksheet. Also some information is different on both sheets. Here is what I want to do....I just don't know how to write the macro code.
**************
Start on "Sheet1"
Look at cell B1 (phone number) if B1 matches a phone number in "Sheet2" column A, cut the whole line from "Sheet2" and paste the line in "Sheet1" starting in F1.

Then move to line2 and go all the way through to end of file.
***********

Does that make sense? ThankS

Please help me out. Thank you!

Bob Phillips
02-08-2007, 08:13 AM
Sub MergeData()
Dim iLastRow As Long
Dim iLastCol As Long
Dim iPos As Long
Dim i As Long

With Worksheets("Sheet1")
iLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = 1 To iLastRow
On Error Resume Next
iPos = 0
iPos = Application.Match(.Cells(i, "B").Value, Worksheets("Sheet2").Range("A:A"), 0)
On Error GoTo 0
If iPos > 0 Then
iLastCol = Worksheets("Sheet2").Cells(iPos, .Columns.Count).End(xlToLeft).Column
Worksheets("Sheet2").Cells(iPos, "A").Resize(1, iLastCol).Copy .Cells(i, "F")
End If
Next i
End With
End Sub

thepartydj
02-08-2007, 08:29 AM
Thank you soo much!! after posting this question on 15 different forums you are the only one that could help me out! Everyone one else either was wrong or didn't answer. Thanks again!

Bob Phillips
02-08-2007, 11:10 AM
I am surprised, it wasn't particulalry tricky.

thepartydj
02-08-2007, 11:13 AM
That is what I thought, I just didn't know how to do it.

However....

I was hoping you could help me out with one more additional line.

I would like to know which files are not copied over, so I would like to add:

"after a line is copied over delete the line on Sheet2" or instead of doing a copy do a cut and paste.

Thank You!

Bob Phillips
02-08-2007, 11:21 AM
Sub MergeData()
Dim iLastRow As Long
Dim iLastCol As Long
Dim iPos As Long
Dim i As Long

With Worksheets("Sheet1")
iLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = 1 To iLastRow
On Error Resume Next
iPos = 0
iPos = Application.Match(.Cells(i, "B").Value, Worksheets("Sheet2").Range("A:A"), 0)
On Error Goto 0
If iPos > 0 Then
iLastCol = Worksheets("Sheet2").Cells(iPos, .Columns.Count).End(xlToLeft).Column
Worksheets("Sheet2").Cells(iPos, "A").Resize(1, iLastCol).Cut .Cells(i, "F")
End If
Next i
End With
End Sub

thepartydj
02-08-2007, 11:30 AM
The code just stops at that line...and errors out. what can it be changed to?

Thanks again.

thepartydj
02-08-2007, 02:41 PM
Thanks, now the above code works

Bob Phillips
02-08-2007, 03:05 PM
Why, what changed?