I am pretty new to VBA and I am having a bit of trouble writing a macro.
I want to search a value in a cell, on a column, that is on another worksheet and if it finds it, copy and paste the whole row where it is to another worksheet.
I pretty much have that one sorted but only doing 1 row. What I can't get to work is that after the first value has been read in "sheetTarget" say in cell T4, found in "sheetToSearch" say in A230 and pasted in row 1 in "sheetPaste" move and read the next cell T5 in "sheetTarget" and then keep repeating the process eg. find value of T5 on A350 and paste in row 2, T6 in A20 and paste on row 3, etc..
Sub copyE()
Dim LCopyToRow As Integer
On Error GoTo Err_Execute
LCopyToRow = 1
Dim sheetPaste As String: sheetPaste = "Sheet11"
Dim sheetTarget As String: sheetTarget = "Sheet8"
Dim sheetToSearch As String: sheetToSearch = "Sheet1"
Dim x As String
Dim columnValue As String: columnValue = "T"
Dim rowValue As Integer: rowValue = 4
Dim LTargetRow As Long
Dim maxRowToTarget As Long: maxRowToTarget = 1000
Dim columnToSearch As String: columnToSearch = "A"
Dim iniRowToSearch As Integer: iniRowToSearch = 5
Dim LSearchRow As Long
Dim maxRowToSearch As Long: maxRowToSearch = 1000
For LTargetRow = rowValue To Sheets(sheetTarget).Rows.Count
Sheets(sheetTarget).Range(columValue & CStr(LTargetRow)).Value = x
For LSearchRow = iniRowToSearch To Sheets(sheetToSearch).Rows.Count
If Sheets(sheetToSearch).Range(columnToSearch & CStr(LSearchRow)).Value = x Then
Sheets(sheetToSearch).Rows(LSearchRow).copy
Sheets(sheetPaste).Rows(LCopyToRow).PasteSpecial Paste:=xlPasteValues
LCopyToRow = LCopyToRow + 1
End If
If (LSearchRow >= maxRowToSearch) Then
Exit For
End If
Next LSearchRow
If (LTargetRow >= maxRowToTarget) Then
Exit For
End If
Next LTargetRow
Application.CutCopyMode = False
Range("A3").Select
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub
I will greatly appreciate any help.
This works for me and I believe it is what you are asking for.
Sub test()
Dim sheetPaste As Worksheet
Dim sheetTarget As Worksheet
Dim sheetToSearch As Worksheet
Dim x As String
Dim columnValue As String: columnValue = "T"
Dim rowValue As Integer: rowValue = 4
Dim LTargetRow As Long
Dim maxRowToTarget As Long: maxRowToTarget = 1000
Dim columnToSearch As String: columnToSearch = "A"
Dim iniRowToSearch As Integer: iniRowToSearch = 5
Dim LSearchRow As Long
Dim maxRowToSearch As Long: maxRowToSearch = 1000
LCopyToRow = 1
Set sheetPaste = ThisWorkbook.Worksheets("Sheet11")
Set sheetTarget = ThisWorkbook.Worksheets("Sheet8")
Set sheetToSearch = ThisWorkbook.Worksheets("Sheet1")
'MsgBox sheetTarget.Cells(Rows.Count, 20).End(xlUp).Row
'finds the last row with a value in it in column T of sheetTarget
For LTargetRow = rowValue To sheetTarget.Cells(Rows.Count, 20).End(xlUp).Row
'targetCell = columValue & CStr(LTargetRow)
'must set x = , not the value in the column = to x (which is not initialize to it is "")
If sheetTarget.Range(columnValue & CStr(LTargetRow)).Text <> "" Then
x = sheetTarget.Range(columnValue & CStr(LTargetRow)).Text
'finds the last row with a value in it in column A of sheetToSearch
For LSearchRow = iniRowToSearch To sheetToSearch.Cells(Rows.Count, 1).End(xlUp).Row
If sheetToSearch.Range(columnToSearch & CStr(LSearchRow)).Value = x Then
sheetToSearch.Rows(LSearchRow).Copy
sheetPaste.Rows(LCopyToRow).PasteSpecial Paste:=xlPasteValues
LCopyToRow = LCopyToRow + 1
Exit For
End If
'dont need this anymore now that we know that last row with data in it.
' If (LSearchRow >= maxRowToSearch) Then
' Exit For
' End If
Next LSearchRow
End If
'If (LTargetRow >= maxRowToTarget) Then
' Exit For
'End If
Next LTargetRow
'Sheets("data").Cells(Rows.Count, 1).End(xlUp).Row
End Sub
Some of the variables are not used anymore and if you have any questions feel free to ask.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.