Macro para colocar datos en la misma fila

Tengo datos en la columna A y B y en la columna C y D. Necesito que los datos de la columna A y C que coincidan se coloque en la misma fila y los que no coincidan que se coloquen en las primeras filas

1 Respuesta

Respuesta
1

H o l a:

Te anexo la macro, los resultados quedarán en las columnas de la E a la L

Sub Diferencias()
'Por.Dante Amor
    u = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
    If u < 3 Then u = 3
    Range("E3:L" & u).ClearContents
    '
    cd = 3 'cajas diferencia
    cn = 3 'cajas no existen en c
    For i = 3 To Range("A" & Rows.Count).End(xlUp).Row
        Set b = Columns("C").Find(Cells(i, "A"), lookat:=xlWhole)
        If Not b Is Nothing Then
            If Cells(i, "B") * -1 <> Cells(b.Row, "D") Then
                Cells(cd, "I") = Cells(i, "A")
                Cells(cd, "J") = Cells(i, "B")
                Cells(cd, "K") = Cells(i, "A")
                Cells(cd, "L") = Cells(b.Row, "D")
                cd = cd + 1
            End If
        Else
            Cells(cn, "E") = Cells(i, "A")
            Cells(cn, "F") = Cells(i, "B")
            cn = cn + 1
        End If
    Next
    '
    cn = 3 'madera no existen en A
    For i = 3 To Range("C" & Rows.Count).End(xlUp).Row
        Set b = Columns("A").Find(Cells(i, "C"), lookat:=xlWhole)
        If b Is Nothing Then
            Cells(cn, "G") = Cells(i, "C")
            Cells(cn, "H") = Cells(i, "D")
            cn = cn + 1
        End If
    Next
    MsgBox "Fin"
End Sub

Avísame si necesitas algo más con respecto a esta macro.


':)
':)

¡Gracias! 

Sub UNO()
Set desti = Sheets("Hoja1")
Sheets("SALIDAS DE MERCANCIA").Select
fila = 2
Range("h2").Select
Do While ActiveCell.Value <> ""
If InStr(valores, ActiveCell) = 0 Then
valores = valores & "," & ActiveCell
End If
ActiveCell.Offset(1, 0).Select
Loop
valores = Mid(valores, 2, Len(valores) - 1)
valores = Split(valores, ",")
For x = 0 To UBound(valores)
contarsi = Application.WorksheetFunction.CountIf(Columns(8), valores(x))
desti.Cells(fila, 1).Value = valores(x)
desti.Cells(fila, 2).Value = contarsi
fila = fila + 1
Next
Sheets("hoja1").Select
    Range("C1").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMIFS('SALIDAS DE MERCANCIA'!C[7],'SALIDAS DE MERCANCIA'!C[5],Hoja1!RC[-2])"
    Range("C1").Select
    Selection.AutoFill Destination:=Range("C1:C733"), Type:=xlFillDefault
    Range("C1:C733").Select
    Sheets("SALIDAS DE PALETAS").Select
    Range("G:G,N:N").Select
    Range("N1").Activate
    Selection.Copy
    Sheets("Hoja1").Select
    Columns("d:d").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Range("d1:d391").Select
Range("d:d").Select
For Each cd In Selection
On Error Resume Next
If Val(cd) <> 0 Then
    cd.Value = cd.Value * 1
    End If
    Next
End Sub
    u = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
    If u < 1 Then u = 1
    Range("F1:M" & u).ClearContents
    '
    cd = 1 'cajas diferencia
    cn = 1 'cajas no existen en c
    For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
        Set b = Columns("D").Find(Cells(i, "A"), lookat:=xlWhole)
        If Not b Is Nothing Then
            If Cells(i, "C") * -1 <> Cells(b.Row, "E") Then
                Cells(cd, "J") = Cells(i, "A")
                Cells(cd, "K") = Cells(i, "C")
                Cells(cd, "L") = Cells(i, "A")
                Cells(cd, "M") = Cells(b.Row, "E")
                cd = cd + 1
            End If
        Else
            Cells(cn, "F") = Cells(i, "A")
            Cells(cn, "G") = Cells(i, "C")
            cn = cn + 1
        End If
    Next
    '
    cn = 1 'madera no existen en A
    For i = 1 To Range("D" & Rows.Count).End(xlUp).Row
        Set b = Columns("A").Find(Cells(i, "D"), lookat:=xlWhole)
        If b Is Nothing Then
            Cells(cn, "H") = Cells(i, "D")
            Cells(cn, "I") = Cells(i, "E")
            cn = cn + 1
        End If
    Next
    MsgBox "Fin"
End Sub

Me da error al enlazarla con la anterior macro el error esta en ActiveSheet lo he marcado en negrita dentro de la macro


Con mucho gusto te ayudo con todas tus peticiones.

Crea una nueva pregunta en todoexpertos, en el tema de microsoft excel, en el desarrollo de la pregunta escribe: "para Dante Amor", ahí me describes con detalle lo que necesitas.

Sal u dos

H o l a:

Antes de esta línea:

u = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row

tienes esto:

End Sub

Quita la línea End Sub y prueba nuevamente.

¡Gracias! 

Lo había probado pero no me daba los resultados correctos

Supongo que tendría algo en la hoja mal

Mañana empezare a trabajar con ella

Gracias

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas