VBA code to search,copy, paste data from all sheets in the same workbook

[AbdulAli]

hello every one i am new to VBA the attach file vba code which works fine but i want to modify it for other workbook it search on only one sheet and only the first occurrence ( i want it to search 8 sheets in the same workbook) it paste the data over the old searched data ( it should find the last row and paste the new data) any kind of help is appreciated thanks in advance

Sub test()

Dim sheetPaste As Worksheet
Dim sheetTarget As Worksheet
Dim sheetToSearch As Worksheet
Dim x As String

Dim columnValue As String: columnValue = "A"
Dim rowValue As Integer: rowValue = 1
Dim LTargetRow As Long
Dim maxRowToTarget As Long: maxRowToTarget = 1000

Dim columnToSearch As String: columnToSearch = "V"
Dim iniRowToSearch As Integer: iniRowToSearch = 1

Dim LSearchRow As Long
Dim maxRowToSearch As Long: maxRowToSearch = 1000

LCopyToRow = 1

Set sheetPaste = ThisWorkbook.Worksheets("sheetPaste")
Set sheetTarget = ThisWorkbook.Worksheets("sheetTarget")
Set sheetToSearch = ThisWorkbook.Worksheets("1")


'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

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheets. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[AbdulAli]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheets. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

Thanks you Mumps:
this is the link ( search.xlsm ) collaborators can download it
i have sheets by the name of (1,2,3,4,5,6,7,8, Targetsheet ,pastedsheet,)
in above sheets the (1,2,3,4,5,6,7,8,) have data and (Targetsheet) have the name to be searched and the (pastedsheet) sheet have the data which is found and pasted by the above code
(1) i want the above code to search for all sheets in the work book ( right now it only search the (1) first sheet and other sheets (2,3,4,5,6,7,8 ) are left
(2) the above code only find the first occurrence in the sheet some times their are more duplicates The code should search for all duplicates in the(1,2,3,4,5,6,7,8,) sheet and paste it in (pastedsheet)
(3) when the above code find the data it paste the new data over the old data The code should find the last row and paste the data below the old data
i hope i have explained it well !!!

 

[mumps]

Unfortunately, your text is in Arabic which I do not understand. Also, you have many merged cells in all your numbered sheets. You should avoid using merged cells because they almost always create problems for Excel macros. You should try to design the layout of your data without any merged cells. If you eliminate the merged cells, you have a better chance of receiving a working solution. Given these two problems, I'm afraid that I won't be able to help. Sorry.

 

[AbdulAli]

Unfortunately, your text is in Arabic which I do not understand. Also, you have many merged cells in all your numbered sheets. You should avoid using merged cells because they almost always create problems for Excel macros. You should try to design the layout of your data without any merged cells. If you eliminate the merged cells, you have a better chance of receiving a working solution. Given these two problems, I'm afraid that I won't be able to help. Sorry.

Thanks you bro some how i have managed the above code to work for me but now i have only one problem. it only search the the first occurrence some times we have duplicates . the code should search for 2nd or 3rd occurrence of the name
Can you modify the code to search till the end of sheet for 2nd or 3rd occurrence

 

[mumps]

This macro will loop through all the sheets and all occurrences:

Sub test()
    Application.ScreenUpdating = False
    Dim sheetPaste As Worksheet, sheetTarget As Worksheet, sheetToSearch As Worksheet, Val As Range, fnd As Range, sAddr As String
    Set sheetPaste = ThisWorkbook.Worksheets("sheetPaste")
    Set sheetTarget = ThisWorkbook.Worksheets("sheetTarget")
    For Each sheetToSearch In Sheets
        If sheetToSearch.Name <> "sheetTarget" And sheetToSearch.Name <> "sheetPaste" Then
            For Each Val In sheetTarget.Range("A1", sheetTarget.Range("A" & sheetTarget.Rows.Count).End(xlUp))
                If Val <> "" Then
                    Set fnd = sheetToSearch.Range("V:V").Find(Val.Value, LookIn:=xlValues, lookat:=xlWhole)
                    If Not fnd Is Nothing Then
                        sAddr = fnd.Address
                        Do
                            fnd.EntireRow.Copy
                            sheetPaste.Cells(sheetPaste.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
                            Set fnd = sheetToSearch.Range("V:V").FindNext(fnd)
                        Loop While fnd.Address <> sAddr
                        sAddr = ""
                    End If
                End If
            Next Val
        End If
    Next sheetToSearch
    Application.ScreenUpdating = True
End Sub

 

[AbdulAli]

This macro will loop through all the sheets and all occurrences:

Sub test()
    Application.ScreenUpdating = False
    Dim sheetPaste As Worksheet, sheetTarget As Worksheet, sheetToSearch As Worksheet, Val As Range, fnd As Range, sAddr As String
    Set sheetPaste = ThisWorkbook.Worksheets("sheetPaste")
    Set sheetTarget = ThisWorkbook.Worksheets("sheetTarget")
    For Each sheetToSearch In Sheets
        If sheetToSearch.Name <> "sheetTarget" And sheetToSearch.Name <> "sheetPaste" Then
            For Each Val In sheetTarget.Range("A1", sheetTarget.Range("A" & sheetTarget.Rows.Count).End(xlUp))
                If Val <> "" Then
                    Set fnd = sheetToSearch.Range("V:V").Find(Val.Value, LookIn:=xlValues, lookat:=xlWhole)
                    If Not fnd Is Nothing Then
                        sAddr = fnd.Address
                        Do
                            fnd.EntireRow.Copy
                            sheetPaste.Cells(sheetPaste.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
                            Set fnd = sheetToSearch.Range("V:V").FindNext(fnd)
                        Loop While fnd.Address <> sAddr
                        sAddr = ""
                    End If
                End If
            Next Val
        End If
    Next sheetToSearch
    Application.ScreenUpdating = True
End Sub

Thanks Bro from your quick reply i have tested the code but it only search the last sheet and its first occurrence here it is a test file ( test 3 .xlsm ) for you thanks in advance for giving me your valuable time

 

[mumps]

Try:

Sub Mr_Mumps_Macro_code()
    Application.ScreenUpdating = False
    Dim sheetPaste As Worksheet, sheetTarget As Worksheet, sheetToSearch As Worksheet
    Dim LastRow As Long, Val As Range, fnd As Range, sAddr As String
    Set sheetPaste = ThisWorkbook.Worksheets("sheetPaste")
    Set sheetTarget = ThisWorkbook.Worksheets("sheetTarget")
    For Each sheetToSearch In Sheets
        If sheetToSearch.Name <> "sheetTarget" And sheetToSearch.Name <> "sheetPaste" Then
            For Each Val In sheetTarget.Range("A1", sheetTarget.Range("A" & sheetTarget.Rows.Count).End(xlUp))
                If Val <> "" Then
                    Set fnd = sheetToSearch.Range("T:T").Find(Val.Value, LookIn:=xlValues, lookat:=xlWhole)
                    If Not fnd Is Nothing Then
                        sAddr = fnd.Address
                        Do
                            LastRow = sheetPaste.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                            fnd.EntireRow.Copy
                            sheetPaste.Range("A" & LastRow).PasteSpecial Paste:=xlPasteValues
                            Set fnd = sheetToSearch.Range("T:T").FindNext(fnd)
                        Loop While fnd.Address <> sAddr
                        sAddr = ""
                    End If
                End If
            Next Val
        End If
    Next sheetToSearch
    Application.ScreenUpdating = True
End Sub

 

[AbdulAli]

very sorry for annoying you again and again
the above code still does not work it extract the whole data i have tested this in (new check.xlsm) file you can download it
Thanks Bro for your hard work and contribution

 

[mumps]

I don't understand exactly what you want the macro to extract. Please upload a file showing your expected results in sheetPaste based on the data in sheetTarget.