Dynamic Array not response
Hi
Your code does not loop over the values in the array, and you have a
fixed destination row in your copy statement:
In the statement below, m is a static value while comparing to values
in Sheet2.
If .Cells(i, "D").Value = rngtrg(m) Then
Look at this:
Sub bbb()
Dim TargetRng As Range
Dim SearchRng As Range
Dim CopyToCell As Range
With Workbooks("X").Worksheets("Sheet1")
Set TargetRng = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
Set CopyToCell = .Range("A" & Rows.Count).End(xlUp).Offset(2, 0)
End With
With Workbooks("WorkbookY.xls").Worksheets("Sheet2")
Set SearchRng = .Range("D1", Range("D" & Rows.Count).End(xlUp))
End With
For Each cell In TargetRng.Cells
For Each c In SearchRng.Cells
If cell.Value = c.Value Then
c.EntireRow.Copy CopyTo
Set CopyToCell = CopyToCell.Offset(1, 0)
End If
Next
Next
End Sub
Hopes this helps.
...
Per
On 5 Feb., 17:12, Len wrote:
Hi,
After several attempts to run the codes below, it fails to copy each
row of data in column A of sheet1 from workbookX instead it copied the
last row of data only ( ie only response to last row in this array
"rngtrg(m)" )
In fact, my intended codes is to copy each row of data in column A of
sheet1 from workbookX and place it in the array, then use each copied
row from the array to search the text string from column D in sheet2
of another workbook(Y),
If found, it will copy each matched row of data back to column A after
the last used cells, of sheet1 in workbookX
Extract of codes
Dim m%, rngtrg$(), klstrw As Long
Dim k As Integer
klstrw = Cells(Rows.Count, "A").End(xlUp).Row
For k = 1 To klstrw
m = m + 1
ReDim Preserve rngtrg(1 To m)
rngtrg(m) = Workbooks("X").Worksheets("Sheet1").Cells(k, 1)
Next k
Windows("WorkbookY.xls").Activate
With Worksheets("Sheet2")
Dim iLastRow As Long, i As Integer
Dim iNextRow As Long
iLastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
For i = 1 To iLastRow
If .Cells(i, "D").Value = rngtrg(m) Then
iNextRow = iNextRow + 1
.Rows(i).Copy Workbooks("X").Worksheets("sheet1").Cells(iNextRow ,
"A").Offset(klstrw + 2, 0)
End If
Next i
End With
Any help on this problem will be much appreciated
Thanks in advance
Regards
Len
|