Macro Excel VBA Buscar y Reemplazar
Estoy tratando de trabajar en una macro de VBA que haga lo siguiente
1) Seleccionar el primer valor (R) de la Hoja1 (Campana)
2) Buscar dichoi valor en la columna B de Hoja2(Basedatos)
3) Si encuentra el valor de la celda, que copie la fla A:H correspondiente a la celda encontrada
4) El valor copiado que lo pegue en la columna de la Hoja1(Campana)
La idea es seleccionar todos los datos de los clientes, que busque el match dependiendo de la ID en la hoja de base de datos y si encuentra match que rellene los datos correspondientes a la ID.
Sub BuscarYReem()
Set Camp = Sheets("Campana")
Set Base = Sheets("Basedatos")
For i = 2 To Camp.Range("R")
Camp.Select
origen = Cells(i, "R") ´aca me falta algo para saltar a la fila siguiente
For j = 2 To Base.Range("B" & Rows.Count).End(xlUp).Row
If origen = Base.Cells(j, "B") Then
Impu.Range("A:H").Copy
Camp.Select
Range("Q:X").PasteSpecial xlPasteAll ´aca no logro haer que copie el rango Qj:Xj
End If
Next
Next
End Sub
Estaba pensando precariamente en algo como esto, estoy incursionando en esto de las macros espero me puedan ayudar!
gracias de ante mano =)
2 Respuestas
H o l a:
Te anexo la macro
Sub BuscaryReemplazar()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Campana")
Set h2 = Sheets("Basedatos")
For i = 2 To h1.Range("R" & Rows.Count).End(xlUp).Row
Set b = h2.Columns("B").Find(h1.Cells(i, "R"), lookat:=xlWhole)
If Not b Is Nothing Then
h2.Range(h2.Cells(b.Row, "A"), h2.Cells(b.Row, "H")).Copy
h1.Cells(i, "Q").PasteSpecial xlValues
End If
Next
Application.ScreenUpdating = True
MsgBox "Terminado"
End Sub
Juan: Hace unos días para otro usuario, le preparé algo similar.
'Este procedimiento Copia Desde la "Hoja1" a la "Hoja3", los datos que Cumplen con el Criterio escrito en Cells(1,6) >> "A1:F1"
'La columna que sondea es la Número 5, o sea la "E"
Sub BuscaCopiaDatos()
Application.ScreenUpdating = False
Dim HojaOrigen As String, HojaDestino As String
Dim FilaOrigen As Integer, FilaDestino As Integer
Dim FilaDondeBuscar As String
Dim Criterio As String
Dim ColumnaCriterio As Integer
HojaOrigen = "Hoja1"
HojaDestino = "Hoja3"
FilaOrigen = 3
FilaDestino = 2
Sheets(HojaDestino).Range("A2:AZ50000").ClearContents
While Sheets(HojaOrigen).Cells(FilaOrigen, 1) <> Empty
Criterio = Sheets(HojaOrigen).Cells(1, 6).Value
ColumnaCriterio = 5
If Sheets(HojaOrigen).Cells(FilaOrigen, ColumnaCriterio) = Criterio Then
FilaDondeBuscar = Cells(FilaOrigen, 1).Row
Sheets(HojaDestino).Cells(FilaDestino, 1) = FilaDondeBuscar & " .- " & Criterio
Sheets(HojaDestino).Cells(FilaDestino, 2) = Sheets(HojaOrigen).Cells(FilaOrigen, 2)
Sheets(HojaDestino).Cells(FilaDestino, 3) = Sheets(HojaOrigen).Cells(FilaOrigen, 3)
Sheets(HojaDestino).Cells(FilaDestino, 4) = Sheets(HojaOrigen).Cells(FilaOrigen, 4)
FilaDestino = FilaDestino + 1
End If
FilaOrigen = FilaOrigen + 1
Wend
'Aquí se pueden insertar líneas de Anchos de Columna, tipo de letra etc....
Application.ScreenUpdating = True
End Sub
Cambia lo que necesites, para adaptarlo a tus necesidades, por ejemplo ColumnCriterio en tu caso será 2, o sea la "B". Saludos >> Jacinto