¿Cómo copiar y pegar datos de celdas múltiples a otra hoja?
En días pasados aprendí a copiar valores de un rango continuo para pegar en otra hoja.
Hoy solicito su amable ayuda un caso similar, se trata de seleccionar datos de celdas discontinuas de un formato, luego de realizar una consulta en dicho formato se agregan nuevos valores (resaltados en color verde) los cuales se requieren copiar y pegar en la hoja "RESUMEN" a partir de la columna "D" y en la fila que corresponda al ID de la consulta.
Envío archivo
1 Respuesta
Respuesta de Dante Amor
2
Te anexo la macro para copiar los datos:
Sub CopiarDatos()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim f As Range
Dim i As Long
Dim cont As String
'
Set sh1 = Sheets("FORMATO")
Set sh2 = Sheets("RESUMEN")
cont = sh1.Range("D21").Value
If cont = "" Then
MsgBox "Captura el número de contrato"
Exit Sub
End If
'
Set f = sh2.Range("B:B").Find(cont, , xlValues, xlWhole, , , False)
If Not f Is Nothing Then
i = f.Row
sh2.Range("D" & i).Value = sh1.Range("T18").Value
sh2.Range("E" & i).Value = sh1.Range("U18").Value
sh2.Range("F" & i).Value = sh1.Range("N23").Value
sh2.Range("G" & i).Value = sh1.Range("S23").Value
sh2.Range("H" & i).Value = sh1.Range("C26").Value
sh2.Range("I" & i).Value = sh1.Range("C27").Value
sh2.Range("J" & i).Value = sh1.Range("E28").Value
sh2.Range("K" & i).Value = sh1.Range("E29").Value
sh2.Range("L" & i).Value = sh1.Range("H29").Value
sh2.Range("M" & i).Value = sh1.Range("H30").Value
MsgBox "Datos copiados"
Else
MsgBox "No existe el No. de Contrato: "
End If
End Sub
