L
Len
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
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