Compara celdas y copia rango de fila
Para poder usar esta macro con otros libros
Sub CopiarRango()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
'
h2.Cells.Clear
j = 1
u = h1.Range("E" & Rows.Count).End(xlUp).Row
For i = 2 To u
If i + 1 <= u Then
If h1.Cells(i, "E") <> h1.Cells(i + 1, "E") Then
h1.Range(h1.Cells(i, "A"), h1.Cells(i, "M")).Copy h2.Cells(j, "A")
j = j + 1
End If
End If
Next
MsgBox "fin"
End Subme gustaría preguntarte:
• ¿Puedo hacer que antes de pegar el código solo borre las columnas donde se va a copiar el rango seleccionado en h2?
H2. Cells. Clear
• Si en vez de 1 rango desde A:M, quiero 2 mas pequeños A:C y E:H entiendo que debo modificar la línea:
H1. Range(h1.Cells(i, "A"), h1.Cells(i, "M")). Copy h2. Cells(j, "A")
por estas otras:
h1.Range(h1.Cells(i, "A"), h1.Cells(i, "C")).Copy h2.Cells(j, "A") H1. Range(h1.Cells(i, "E"), h1.Cells(i, "H")). Copy h2. Cells(j, "A")
Pero no se como unirlas con and o si consideras es mejor repetir todo el proceso desde el if para la segunda línea.
1 respuesta
Respuesta de Dante Amor
1
H o l a:
Te anexo la macro actualizada:
Sub CopiarRango()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
'
h2.Range("A:G").Clear
j = 1
u = h1.Range("E" & Rows.Count).End(xlUp).Row
For i = 2 To u
If i + 1 <= u Then
If h1.Cells(i, "E") <> h1.Cells(i + 1, "E") Then
h1.Range(h1.Cells(i, "A"), h1.Cells(i, "C")).Copy h2.Cells(j, "A")
h1.Range(h1.Cells(i, "E"), h1.Cells(i, "H")).Copy h2.Cells(j, "D")
j = j + 1
End If
End If
Next
MsgBox "fin"
End Sub
