Mejorar Macro que Copia datos de Hoja a Hoja segun condición

Espero lo hayan pasado bien en esta navidad y que este año nuevo sea de lo mejor para todos ustedes, escribo.

Por que tengo un problema:

Y es que quiero mejorar esta macro:

Lo que hace el primer procedimeinto, es copiar los datos de una hoja a otra ( Hoja3 a Hoja1) si coniciden los códigos, es decir si es que los código que estan en la columna (A) de la hoja 3 coinciden con los códigos qu esta en la columna ("G") de la hoja1, se copian los datos de la columnas Cy D de la hoja 3 a las columnas ( "Q" y "P") de la hoja 1, respectivamente. Y si no encuentra el código sale un mensaje que indica que el código no existe en la Hoja1 por lo que nos e copia ningún dato.

Hasta ahí todo bien, sin embargo he tratado de poner una "X" en las columna "E" de la hoja 3 a aquellos códigos cuyos datos fuerón copiados a la hoja 1 pero no lo he conseguido. La macro que se ha tratado de hacer esta en el segundo procedimiento("ponex"), pero lo hace a todos cuyo celda este vacia incluyendo a aquellas filas cuyos datos no han sido pasado a la hoja1 por que el código no existe.

Lo que busco es que ponga una X a las celdas de la columna "E" cuyos datos hans sido copiados por que los código coinciden.

Espero puedan ayudarme y haberme dejado entender.

 Sub CopiaDatosHoja1() 'esta macro actualiza los datosÁCTUALIZA EL KARDEX DE LA MADERA EN TROZAS CON RESPECTO A LO ASERRADO
Application.ScreenUpdating = False
Ufc = Hoja3.Range("A9").End(xlDown).Row
Hoja3.Select
        Range("A10").Select
        Do Until ActiveCell = "" 'ubica el código
        varcod = ActiveCell
        VarPlanta = ActiveCell.Offset(0, 2)
        VarFecha = ActiveCell.Offset(0, 3)
        VARMOV = ActiveCell.Offset(0, 4)
        Hoja1.Select
        Range("G13").Select 'busca el código en la column "g" partuendo desde G13
        sw = 0
        Do Until ActiveCell = ""
        If ActiveCell.Value = varcod Then
        sw = 1
        If VARMOV = "" Then 'entrada
        ActiveCell.Offset(0, 9).Value = VarFecha
        ActiveCell.Offset(0, 10).Value = VarPlanta
        VARMOV = "X" 'debe poner una x pero no lo hace?
        Else
        End If
        End If
        ActiveCell.Offset(1, 0).Select
        Loop
        If sw <> 1 Then
        MsgBox ("Troza no registrada:" & "" & varcod)
        End If
        Hoja3.Select
        ActiveCell.Offset(1, 0).Select
          'ponex '=====como modifico esta macro DE TAL MANERA  QUE  LO HAGA SOLAMENTE CUANDO LOS CÓDIGOS COINCIDEN TAL COMO
        Loop
     End Sub
'____________________
  Sub ponex() 
'http://www.todoexpertos.com
'ESTA MACRO PONE UNA X  CUANDO LOS DATOS DE LAS COLUMNAS C Y D FUERON COPIADOS A
  'LA HOJA1, SIN EMBARGO SE NECESITA MODIFICAR POR QUE LO HACE en toda la columna siempre que esten vacios.
  Ufc = Hoja3.Range("A9").End(xlDown).Row
Hoja3.Select
        ActiveCell.Offset(1, 0).Select
        Contador = 0
  For i = 10 To Ufc
  If Range("E" & i) = "" Then
    Contador = Contador + 1
  Range("E" & i) = "X"
End If
  Next
MsgBox ("Se han considerado " & Str(Contador) & " Trozas")
Hoja3.Activate
'End If
End Sub

Saludos.

Y un Gran Año venidero para todos ustedes.

Celim

1 Respuesta

Respuesta
1

Te anexo la macro con la actualización, las líneas que agregué están entre ini y fin

Sub CopiaDatosHoja1() 'esta macro actualiza los datosÁCTUALIZA EL KARDEX DE LA MADERA EN TROZAS CON RESPECTO A LO ASERRADO
    Application.ScreenUpdating = False
    Ufc = hoja3.Range("A9").End(xlDown).Row
    hoja3.Select
    Range("A10").Select
    Do Until ActiveCell = "" 'ubica el código
        'Ini.Por.DAM
        fila = ActiveCell.Row
        'Fin.Por.DAM
        varcod = ActiveCell
        VarPlanta = ActiveCell.Offset(0, 2)
        VarFecha = ActiveCell.Offset(0, 3)
        VARMOV = ActiveCell.Offset(0, 4)
        Hoja1.Select
        Range("G13").Select 'busca el código en la column "g" partuendo desde G13
        sw = 0
        Do Until ActiveCell = ""
            If ActiveCell.Value = varcod Then
                sw = 1
                If VARMOV = "" Then 'entrada
                    ActiveCell.Offset(0, 9).Value = VarFecha
                    ActiveCell.Offset(0, 10).Value = VarPlanta
                    'Ini.Por.DAM
                    'VARMOV = "X" 'debe poner una x pero no lo hace?
                    hoja3.Cells(fila, "E") = "X"
                    'Fin.Por.DAM
                Else
                End If
            End If
            ActiveCell.Offset(1, 0).Select
        Loop
        If sw <> 1 Then
            MsgBox ("Troza no registrada:" & "" & varcod)
        End If
        hoja3.Select
        ActiveCell.Offset(1, 0).Select
        'ponex '=====como modifico esta macro DE TAL MANERA  QUE  LO HAGA SOLAMENTE CUANDO LOS CÓDIGOS COINCIDEN TAL COMO
    Loop
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas