match some fields & write new file
This is the kind of thing. You'll want to amend it (unless you're happy to
wait for a couple of hours!) as it currently compares all empty cells too.
It also pastes to a sheet in the same workbook (sheet3) rather than a
workbook:
Sub PasteMatches()
Dim cell1 As Range
Dim cell2 As Range
For Each cell1 In Worksheets("Sheet1").Columns(1).Cells
For Each cell2 In Worksheets("Sheet2").Columns(1).Cells
If cell2.Value & cell2.Offset(0, 1).Value & cell2.Offset(0, 2).Value
& cell2.Offset(0, 3).Value = cell1.Value & cell1.Offset(0, 1).Value &
cell1.Offset(0, 2).Value & cell1.Offset(0, 3).Value Then
cell2.EntireRow.Copy
Worksheets("Sheet3").Activate
Range("A1").CurrentRegion.Select
Selection.Offset(Selection.Rows.Count).Resize(1, 1).Select
ActiveSheet.Paste
End If
Next cell2
Next cell1
End Sub
"Eddy Stan" wrote:
Hi everyone,
I have 2 sheets in a workbook.
Sheet1 has 14 fields and first 4 are unique
Sheet2 has 21 fields and first 4 are unique (say equal to sheet1)
Now, How to pick each row from sheet1 (4 fields) find their equals in sheet2
collect those equal rows and put in a new workbook and close with a new name.
Any help on this please (code or links).
|