View Full Version : Solved: Copy Data of duplicate item to first sheet .
parscon
08-14-2012, 04:05 PM
thats my Final Request . hope all of you pardon me .
I need another VBA code if find duplicate copy the data (row)to sheet 1
That mean, I have data on column A like 23456 and also Ihave the same on column A on sheet 2
When run VBA copy the data of on column B-C-D-E-H on sheet 2 to sheet 1
Example : on Sheet 1 on Column A we have :
Column A
234567
on Sheet 2 we have these data
Column A Column B Column C ColumnD ColumnE Column H
234567 DATA-1 DATA-2 DATA-3 DATA-4 DATA-5
When run VBA in Sheet1 Column A : copy the data from sheet 2 to this sheet.
Column A Column B Column C ColumnD ColumnE Column H
234567 DATA-1 DATA-2 DATA-3 DATA-4 DATA-5
Zack Barresse
08-14-2012, 05:10 PM
Hi there,
Why do you need VBA for this? Why not just use VLOOKUP?
=VLOOKUP($A2,Sheet2!$A:$A,COLUMN(B$1),0)
This assumes you are putting the formula in Sheet1 in B2. Copy across to the right, then down as needed.
HTH
parscon
08-14-2012, 10:04 PM
it is not work and also i need a VBA for this , :(
Please test in a sample file .
I found VBA but it is for 2 workbook , i need this for 2 sheet and also this code will search all sheet but i need search just 1 sheet . Please help me .
Sub PNCHECKER()
Dim i As Long
Dim Parts As Worksheet
Dim Numbers As Worksheet
Dim F_Rng As Range
Dim T_Str As String
Dim L_Rw As Long
Set Parts = ThisWorkbook.Sheets("Sheet1")
With Parts
L_Rw = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To L_Rw
T_Str = .Cells(i, 1).Value
For Each Numbers In Workbooks("Numbers").Sheets
With Numbers
Set F_Rng = .Range("a:a").Find(T_Str, , , xlWhole)
If Not F_Rng Is Nothing Then
F_Rng.Offset(, 1).Resize(, 4).Copy Parts.Cells(i, 2)
Exit For
End If
End With
Next
Next i
End With
Set F_Rng = Nothing
Set Numbers = Nothing
Set Parts = Nothing
End Sub
parscon
08-15-2012, 03:11 AM
I found some thing but need some help to complete this .
1- there is a range but i want check all data on column A not A1:A5 for both sheet .
Please help me .
Sub moving()
Dim c As Range, d As Range
Worksheets("Sheet2").Activate
For Each c In Range("A1:A15")
For Each d In Worksheets("Sheet1").Range("A1:A4")
If c = d Then
c.Resize(1, 4).Copy Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0)
Exit For
End If
Next
Next
End Sub
parscon
08-15-2012, 05:23 AM
Please some body help me . now i changed Sheet1 Range to A1:A65 but i have 64 row and when run this code excel will be freezed but when change to 64 it is work , i have problem because i can not change the number manualy so need select auto.
How can do it . HELP HELP Please
Sub moving()
Dim c As Range, d As Range
Worksheets("Sheet2").Activate
For Each c In Range("A1:A65536")
For Each d In Worksheets("Sheet1").Range("A1:A65")
If c = d Then
c.Resize(1, 4).Copy Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0)
Exit For
End If
Next
Next
End Sub
Bob Phillips
08-15-2012, 05:42 AM
Untested
Sub moving()
Dim idx As Long
For Each d In Worksheets("Sheet1").Range("A1:A65")
idx = 0
On Error Resume Next
idx = Application.Match(d.Value, Worksheets("Sheet2").Columns("A"), 0)
On Error GoTo 0
If idx > 0 Then
Worksheets("Sheet2").Cells(idx, 1).Resize(1, 4).Copy _
Worksheets("Sheet3").Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next i
End Sub
parscon
08-15-2012, 05:59 AM
Dear Xld
Invalid or unqualified refrence and when click ok select .Rows
Worksheets("Sheet3").Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
Bob Phillips
08-15-2012, 06:21 AM
Said it was untested!
Sub moving()
Dim idx As Long
For Each d In Worksheets("Sheet1").Range("A1:A65")
idx = 0
On Error Resume Next
idx = Application.Match(d.Value, Worksheets("Sheet2").Columns("A"), 0)
On Error Goto 0
If idx > 0 Then
Worksheets("Sheet2").Cells(idx, 1).Resize(1, 4).Copy _
Worksheets("Sheet3").Cells(Worksheets("Sheet3").Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next i
End Sub
parscon
08-15-2012, 06:24 AM
Dear , Xld ,
i never blamed you , It is your kind that you help peoples.
again the same error but end of code i of Next .
i removed i and code work .
Thank you again .
Bob Phillips
08-15-2012, 07:27 AM
That should be Next d, and the d shoule be Dimensioned of course.
My bad :(
parscon
08-15-2012, 08:46 AM
Dear Xld , is it true now ?
Sub moving()
Dim idx As Long
For Each d In Worksheets("Sheet1").Range("A1:A65")
idx = 0
On Error Resume Next
idx = Application.Match(d.Value, Worksheets("Sheet2").Columns("A"), 0)
On Error GoTo 0
If idx > 0 Then
Worksheets("Sheet2").Cells(idx, 1).Resize(1, 4).Copy _
Worksheets("Sheet3").Cells(Worksheets("Sheet3").Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next d
End Sub
Zack Barresse
08-15-2012, 06:37 PM
Don't you want to offset it to column B, and go 5 columns? If so, make a slight adjustment...
Sub moving()
Dim idx As Long
Dim d As range
For Each d In Worksheets("Sheet1").Range("A1:A65")
idx = 0
On Error Resume Next
idx = Application.Match(d.Value, Worksheets("Sheet2").Columns("A"), 0)
On Error Goto 0
If idx > 0 Then
Worksheets("Sheet2").Cells(idx, 2).Resize(1, 5).Copy _
Worksheets("Sheet3").Cells(Worksheets("Sheet3").Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next d
End Sub
parscon
08-15-2012, 11:52 PM
Dear Zack Barresse
Hope so you are fine and thank you for your big help .
just i have a question , is there any way to copy the data on same sheet that mean sheet 1 and start from column B ? like my sample in top of topic .
Thank you very much .
BigDawg15
08-16-2012, 08:39 AM
Parscon,
Try this. Slight modification to Zack Barresse's Code.
Sub moving()
Dim idx As Long
For Each d In Worksheets("Sheet1").Range("A1:A65")
idx = 0
On Error Resume Next
idx = Application.Match(d.Value, Worksheets("Sheet2").Columns("A"), 0)
On Error GoTo 0
If idx > 0 Then
Worksheets("Sheet2").Cells(idx, 1).Resize(1, 6).Copy _
Worksheets("Sheet3").Cells(Worksheets("Sheet3").Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next d
End Sub
BigDawg15
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.