Ampliar rango de búsqueda de una macros que copia y pega valores en un mismo libro

Tengo una macros que realiza búsqueda de un determinado valor en una hoja de excel y copia los valores de las columnas a otra hoja diferente pero necesito que la macros haga la misma función con otras dos hojas más que están en el mismo libro

A continuación les dejo una copia del código existente que tengo

Sub Detailedinformation()

    Dim lastrowdetailed As Long

    Dim lastrowtraineeengineers As Long

    Dim Name As String

    Dim code As String

    Dim Finishinduction As String

    Dim Amadibasetrainingfinishdatequiz As String

    Dim stembarkationdate As String

    Dim stdisembark As String

    Dim Dateofassessment As String

    Dim Comments As String

    Dim ndembarcationdate As String

    Dim nddisembark As String

    Dim ndDateofassessment As String

    Dim ndComments As String

    Dim rdembarcationdate As String

    Dim rddisembark As String

    Dim rdDateofassessment As String

    Dim rdComments As String

    Dim cont As Long

    code = Sheets("detailed").Cells(2, 4)

    code = "*" & code & "*"

    lastrow = Sheets("Trainee Engineers").Range("C" & Rows.Count).End(xlUp).Row

    If lastrow < 4 Then

       Exit Sub

    End If

        For cont = 4 To lastrow

            If Sheets("Trainee Engineers").Cells(cont, 4) Like code Then

               Name = Sheets("Trainee Engineers").Cells(cont, 3)

               code = Sheets("Trainee Engineers").Cells(cont, 4)

               Finishinduction = Sheets("Trainee Engineers").Cells(cont, 7)

               AmadiBasetrainingFinishDateAndQuiz = Sheets("Trainee Engineers").Cells(cont, 10)

               stembarkationdate = Sheets("Trainee Engineers").Cells(cont, 14)

               stdisembark = Sheets("Trainee Engineers").Cells(cont, 15)

               Dateofassessment = Sheets("Trainee Engineers").Cells(cont, 18)

               Comments = Sheets("Trainee Engineers").Cells(cont, 19)

               ndembarkationdate = Sheets("Trainee Engineers").Cells(cont, 20)

               nddisembark = Sheets("Trainee Engineers").Cells(cont, 21)

               ndDateofassessment = Sheets("Trainee Engineers").Cells(cont, 24)

               ndComments = Sheets("Trainee Engineers").Cells(cont, 25)

               rdembarkationdate = Sheets("Trainee Engineers").Cells(cont, 26)

               rddisembark = Sheets("Trainee Engineers").Cells(cont, 27)

               rdDateofassessment = Sheets("Trainee Engineers").Cells(cont, 30)

               rdComments = Sheets("Trainee Engineers").Cells(cont, 31)

               lastrowdetailed = Sheets("detailed").Range("C" & Rows.Count).End(xlUp).Row

               Sheets("detailed").Cells(lastrowdetailed + 1, 3) = Name

               Sheets("detailed").Cells(lastrowdetailed + 1, 4) = code

               Sheets("detailed").Cells(lastrowdetailed + 1, 5) = Finishinduction

               Sheets("detailed").Cells(lastrowdetailed + 1, 6) = AmadiBasetrainingFinishDateAndQuiz

               Sheets("detailed").Cells(lastrowdetailed + 1, 7) = stembarkationdate

               Sheets("detailed").Cells(lastrowdetailed + 1, 8) = disembark

               Sheets("detailed").Cells(lastrowdetailed + 1, 9) = Dateofassessment

               Sheets("detailed").Cells(lastrowdetailed + 1, 10) = Comments

               Sheets("detailed").Cells(lastrowdetailed + 1, 11) = ndembarkationdate

               Sheets("detailed").Cells(lastrowdetailed + 1, 12) = disembark

               Sheets("detailed").Cells(lastrowdetailed + 1, 13) = Dateofassessment

               Sheets("detailed").Cells(lastrowdetailed + 1, 14) = Comments

               Sheets("detailed").Cells(lastrowdetailed + 1, 15) = rdembarkationdate

               Sheets("detailed").Cells(lastrowdetailed + 1, 16) = disembark

               Sheets("detailed").Cells(lastrowdetailed + 1, 17) = Dateofassessment

               Sheets("detailed").Cells(lastrowdetailed + 1, 18) = Comments

            End If

End Sub

Añade tu respuesta

Haz clic para o