Copiar información de un archivo a otro otros archivos
Requiero copiar de unos archivos a otro
De este archivo requiero pasar b11, b12, b13, y los campos de la columna C Y F si f es aceptado a este archivo
Es importante aclarar que el archivo 1 es cambiante, es decir que hay varios archivos con la misma estructura pero diferentes nombre, estos archivos se generar con una macro y se debe dilienciar la columnas E, F Y G porque son de análisis
1 Respuesta
Prueba la siguiente macro.
- Los dos archivos deben estar abiertos.
- Pon la macro en el libro destino.
- Cambia en la macro el nombre del libro que contiene la información en esta línea:
Set wb2 = Workbooks("Libro2.xlsx")
- La macro tomará los datos de la primera hoja.
- Los datos se pegarán en el libro1, en la "Hoja1", en las columnas A la E.
- La macro copiará los datos que tengan el texto "SE ACEPTA" en la columna "E" (según tu primera imagen)
Sub copiarDatos()
'Por Dante Amor
Dim sh1 As Worksheet, sh2 As Worksheet
Dim wb2 As Workbook
Dim i As Long, lr1 As Long, lr2 As Long
'
Set sh1 = ThisWorkbook.Sheets("Hoja1")
Set wb2 = Workbooks("Libro2.xlsx")
Set sh2 = wb2.Sheets(1)
'
lr1 = sh1.Range("A" & Rows.Count).End(3).Row + 1
lr2 = sh2.Range("C" & Rows.Count).End(3).Row
For i = 16 To lr2
If UCase(Left(sh2.Range("E" & i).Value, 9)) = "SE ACEPTA" Then
sh1.Range("A" & lr1).Value = sh2.Range("B11").Value
sh1.Range("B" & lr1).Value = sh2.Range("B12").Value
sh1.Range("C" & lr1).Value = sh2.Range("B13").Value
sh1.Range("D" & lr1).Value = sh2.Range("C" & i).Value
sh1.Range("E" & lr1).Value = sh2.Range("F" & i).Value
lr1 = lr1 + 1
End If
Next
End Sub
