parscon
01-09-2014, 06:48 AM
I have a workbook with one sheet (sheet1) with column A and also i have another workbook with name SourcePart.
The below VBA code will be check the items on column A on sheet 1 and if find the same on workbook SourcePart will copy data to sheet 1 on column B and c ... .
Now my problem is Example :
Sheet1 :
A1: Book
Workbook SourcePart
Sheet1:
E300: Book
it will copy the data after E300 that mean it will not copy from A300 , i need if find data on each column copy the complete row , not after found matched data .
Hope you will understand .
Sub WNChecker()
Dim i As Long
Dim Parts As Worksheet
Dim SourcePart 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 SourcePart In Workbooks("SourcePart").Sheets
With SourcePart
Set F_Rng = .Range("A:P").Find(T_Str, , , xlWhole)
If Not F_Rng Is Nothing Then
F_Rng.Offset(, 1).Resize(, 20).Copy Parts.Cells(i, 2)
Exit For
End If
End With
Next
Next i
End With
Set F_Rng = Nothing
Set SourcePart = Nothing
Set Parts = Nothing
End Sub
The below VBA code will be check the items on column A on sheet 1 and if find the same on workbook SourcePart will copy data to sheet 1 on column B and c ... .
Now my problem is Example :
Sheet1 :
A1: Book
Workbook SourcePart
Sheet1:
E300: Book
it will copy the data after E300 that mean it will not copy from A300 , i need if find data on each column copy the complete row , not after found matched data .
Hope you will understand .
Sub WNChecker()
Dim i As Long
Dim Parts As Worksheet
Dim SourcePart 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 SourcePart In Workbooks("SourcePart").Sheets
With SourcePart
Set F_Rng = .Range("A:P").Find(T_Str, , , xlWhole)
If Not F_Rng Is Nothing Then
F_Rng.Offset(, 1).Resize(, 20).Copy Parts.Cells(i, 2)
Exit For
End If
End With
Next
Next i
End With
Set F_Rng = Nothing
Set SourcePart = Nothing
Set Parts = Nothing
End Sub