Excel macro help

  • Thread starter Thread starter thepartydj
  • Start date Start date
T

thepartydj

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!
 
One way:

Public Sub CopyInfo()
Dim rCell As Range
Dim rSearch As Range
Dim rFound As Range
Dim nCols As Long

With Workbooks("WB1.xls")
With .Sheets("Sheet2")
nCols = .Columns.Count - 5
Set rSearch = .Range(.Range("B1"), _
.Range("B" & .Rows.Count).End(xlUp))
End With
With .Sheets("Sheet1")
For Each rCell In rSearch
Set rFound = .Columns(1).Cells.Find( _
What:=rCell.Text, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=False)
If Not rFound Is Nothing Then
rCell.Offset(0, 4).Resize(1, nCols).Value = _
rFound.EntireRow.Resize(1, nCols).Value
End If
Next rCell
End With
End With
End Sub
 
And just so you'll have an option:

Sub MoveMatchedData()
Dim sourceList As Range
Dim anySourceCell As Object
Dim destList As Range
Dim anyDestCell As Object
Dim copyFromRange As Range
Dim copyToRange As Range
Dim copiedOffset As Long

Set sourceList = Worksheets("Sheet2").Range("A1:" & _
Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Address)
Set destList = Worksheets("Sheet1").Range("B1:" & _
Worksheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Address)
For Each anySourceCell In sourceList
If Not IsEmpty(anySourceCell) Then
For Each anyDestCell In destList
If Not IsEmpty(anyDestCell) Then
If anySourceCell = anyDestCell Then
'matched, copy data
'since it's not a column to column match
'we need some offset values
copiedOffset = Worksheets("Sheet2").Range("IV" & _
anySourceCell.Row).End(xlToLeft).Column - 1
Set copyFromRange = Worksheets("Sheet2"). _
Range(Range("A" & anySourceCell.Row & ":" & _
Range("A" & anySourceCell.Row).Offset(0, _
copiedOffset).Address).Address)
Set copyToRange = Worksheets("Sheet1"). _
Range(Range("F" & anyDestCell.Row).Address & ":" & _
Range("F" & anyDestCell.Row).Offset(0, _
copiedOffset).Address)
copyToRange.Value = copyFromRange.Value
End If
End If
Next
End If
Next
End Sub
 
Back
Top