PDA

View Full Version : Find data from other workbook-Copy All column on row



parscon
04-20-2014, 07:56 AM
I have a below VBA code and this code will check the column A on sheet1 and search the value in column A and if find match data will on column C

Now i need check column A and B and if find match data like these column on another workbook paste data .
The section of code must be change is T_Str = .Cells(i, 1).Value but i do not know how . please help me .


Sub SourcePart()
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("DATA.xlsx").Sheets
With SourcePart
Set F_Rng = .Range("A:P").Cells.Find(T_Str, , , xlWhole)
If Not F_Rng Is Nothing And Not IsEmpty(F_Rng) Then
F_Rng.Cells.Offset(, 1).EntireRow.Resize(, 5).Copy Parts.Cells(i, 2)
Exit For
End If
End With
Next SourcePart
Next i
End With
End Sub

Simon Lloyd
04-21-2014, 11:09 PM
HAve you checked that codes operation? it doesn't only work on column C, it FINDs the match in the range A:P and puts the results in sheet1 column B, this bit T_Str = .Cells(i, 1).Value is simply geiving the value to look for so in the first instance it will be looking at ROW 1, COLUMN 1, the cells expression is used like this Cells(RowIndex, ColumnIndex).

parscon
04-21-2014, 11:15 PM
Dear Sir, Thank you

I need to check column A and B and if find exact data on workbook data copy the column C from workbook data to current sheet.
Now the problem is T_Str = .Cells(i, 1).Value only check column A on sheet1 in another workbook that I run the code I need check column A and B

Thanks for your help.




Sub SourcePart()
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("DATA.xlsx").Sheets
With SourcePart
Set F_Rng = .Range("A:B").Cells.Find(T_Str, , , xlWhole)
If Not F_Rng Is Nothing And Not IsEmpty(F_Rng) Then
F_Rng.Cells.Offset(, 1).EntireRow.Resize(, 5).Copy Parts.Cells(i, 3)
Exit For
End If
End With
Next SourcePart
Next i
End With
End Sub