Macro VBA Excel para extraer datos filas con condición y copiar en columnas de otra hoja
Tengo una hoja Excel ("BBDD") con datos de clientes y otra hoja Excel en el mismo archivo donde debería copiarlos con una estructura distinta ("Sheet 1").
Los datos que quiero extraer de la hoja "BBDD" están en la columna "E" y deben cumplir con un campo especificado/indicador de la columna "B".
Es decir, en la columna E se encuentra toda la información y en la columna B el tipo de información que contiene cada una de las celdas de la columna E. Por ejemplo, en la celda B3 aparece el texto "'Empresa :" y en la celda E3 aparece el texto del nombre de la empresa, en la celda B4 aparece el texto "'Correo Electrónico :" y en la celda E4 la dirección de correo electrónico y así sucesivamente con más de 200 empresas.
Los datos de la columna E debo copiarlos en la hoja "Sheet 1" en distintas columnas (una por cada campo). Por ejemplo, en la columna A los distintos nombres de empresa y en la columna B las direcciones de correo electrónico.
¿Me podrían ayudar a elaborar la macro VBA?
Lo he intentado hacer modificando/adaptando otras macros que he encontrado en todoexpertos pero no lo he conseguido.
Muchas gracias de antemano. Reciban un cordial saludo,
Alex
1 Respuesta
Como no subes un ejemplo de lo que necesitas te muestro el resultado de esta macro, en la hoja BBDD en la columna B están las leyendas y en la columna E están los nombre de las empresas y su correo electrónico, la macro lo que hace es separar empresas de correos y las correlaciona en la hoja 1 empresas en la columna A, correos en la columna B
y esta es la macro
Sub copia()
With Sheets("bbdd").Range("e3")
For i = 1 To .CurrentRegion.Rows.Count / 2
Range("a1").Cells(i) = .Cells(i * 2 - 1)
Range("b1").Cells(i) = .Cells(i * 2)
Next i
End With
End Sub
Sorry una corrección en la macro olvide incluir en nombre de la hoja1, sino te pondrá la copia en la hoja BBDD o la que estés usando
Sub copia()
With Sheets("bbdd").Range("e3")
For i = 1 To .CurrentRegion.Rows.Count / 2
Sheets("hoja1").Range("a1").Cells(i) = .Cells(i * 2 - 1)
Sheets("hoja1").Range("b1").Cells(i) = .Cells(i * 2)
Next i
End With
End Sub
Buenos días y gracias por tu pronta respuesta. No había caído en que podía mandar archivos y por eso había tratado de simplificar para que fuera más sencillo de explicar.
En el siguiente enlace hay un ejemplo contactos de tres empresas en la hoja "BBDD" que debería trasladar a la hoja "Sheet 1" en otro formato.:
En la realidad el problema es que debo hacerlo para un listado de cientos de empresas con un formato de exportación como el que aparece en el enlace y por eso estoy buscando un modo para automatizar el proceso en la medida de lo posible. He probado con la macro que me has mandado y creo que hay un problema cuando lo ejecuto porque existen campos vacíos y no soy capaz de adaptar la macro.
Agradecería ayuda en este menester.
Mil gracias de antemano,
Alex
Solo viene la información en la hoja BBDD, no viene ninguna hoja sheets1, ¿cómo quieres que quede?.
Buenos días,
Ya he rellenado la hoja sheets1 con la información de la hoja BBDD que necesitaría que figurase en la misma:
Muchas gracias por el interés en ayudarme.
Recibe un saludo,
Alex
Este es el resultado de la macro te pasa la información de la hoja BBDD a la hoja 2
y esta es la macro
Sub extraer()
campos = Array("Código :", "Empresa :", _
"Correo electrónico :", "Dirección :", "Localidad :", _
"Código Postal :", "Provincia :", "NIF :", "Notas:", "IBAN :", _
"Código :", "Forma de cobro :", "régimen del IVA :")
campos = Application.Transpose(Application.Transpose(campos))
filas = Sheets("bbdd").Range("b" & Rows.Count).End(xlUp).Row
Set datos = Sheets("bbdd").Range("b3").Resize(filas, 4)
For i = 1 To UBound(campos)
With datos
.AutoFilter 1, campos(i)
.Offset(1, 3).Copy
Sheets("hoja2").Cells(i).PasteSpecial
End With
Next i
Sheets("hoja2"). Range("a1"). CurrentRegion. EntireColumn. AutoFit
Sheets("bbdd"). Range("b3"). AutoFilter
End Sub
