Copiar una fila de hoja1 a otra fila de hojas con una condición de valor de una parte de una celda de hoja1

¿Puedes poner algunos ejemplos de los textos que hay en la columna G?

¿Puedes también decir que parte del texto es la que quieres extraer?

Hola Andy

Este es un Ejemplo de un celda de la columna que quiero que se verifique.

1. En la Hoja 1, hay una columna (G) que identifica muchos conceptos que se representan con 6 Cifras (390003) y un texto antes y después del número. Las cifras pueden ser por ejemplo 390005, 390007, 390009... etc... : Ejemplo "33-ESAB - 390003 DOCENCIA - CONFERENCIES".
2. La cosa se complica ya que cada mismo numero (en este caso 390003) puede estar asociado a diferentes textos. En el ejemplo el texto después es "DOCENCIA - CONFERENCIES" pero puede ser también "DOCENCIA - COORDINADORS I TFG", "DOCENCIA - CAMPO"... y el texto antes "33-ESAB" pero puede ser "34-MAP", "39-CAP"...
3. De esta Hoja 1, quiero buscar en la calumna G SOLO los valores que contengan por ejemplo 390003 (da igual el texto asociado) y copiar los valores de la fila correspondiente del rango "A" a "I" a la hoja 2 y pegarlos empezando del rango A2 a I2.
   Espero que me hay explicado bien Andy
   Muchísimas Gracias

Hi Zein,

Pensé que la respuesta de James te había servido por eso no te respondí mas, pero parece que no es lo que buscas. Pero bueno aquí tienes otra manera de hacerlo. Lo he probado con 30,000 (30k) de filas y corre en milisegundos. Yo suelo evitar el Copy & Paste, en mi opinión es lento y torpe. Observa el poder de transferir Arrays.

Video demo: ver video demo

Este es el código:

Sub TransferData()
Dim LookFor As String
Dim HojaOrigen As Worksheet: Set HojaOrigen = Sheets("Sheet1")
Dim HojaDestino As Worksheet: Set HojaDestino = Sheets("Sheet2")
Dim uF As Long: uF = HojaOrigen.Range("G" & Rows.Count).End(xlUp).Row
Dim nF As Long
Dim rCell As Range, rRng As Range
Set rRng = Range("G2:G" & uF)
Dim RowArr() As Variant
Dim testStr() As String
LookFor = InputBox("Que concepto quiere copiar?", "Escriba el codigo del concepto")
If LookFor <> "" Then
For Each rCell In rRng.Cells
nF = HojaDestino.Range("A" & Rows.Count).End(xlUp).Row + 1
    testStr() = Split(rCell.Value)
    If LookFor = testStr(2) Then
        RowArr() = HojaOrigen.Range(Cells(rCell.Row, 1), Cells(rCell.Row, 8)).Value2
        HojaDestino.Range("A" & nF & ":H" & nF).Value2 = RowArr()
        Erase RowArr
    End If
Next rCell
MsgBox "HECHO!", vbInformation, "Ya..."
End If
End Sub

Yo no sé como es tu libro, así que el código deberás ajustarlo al nombre de tus hojas y a la cantidad de columnas y/o rango de la fila que vas a pasar a la otra hoja.

Si no te funciona, sera mejor que compartas el libro, para ver como están estructurados los datos.

Perdón, puse un vídeo en el que solo probé 3 mil filas.. Este es el vídeo correcto de las 30 mil filas.

Video: video demo

demoro 1 segundo y medio, o 2.

Hola Andy
Primero muchas gracias por la macro. Estoy de acuerdo contigo que copiar y pegar no es nada eficiente cuando tienes mucha cantidad de datos.
Viendo el demo, lo difícil parece viéndote como lo manejas ;), pero no me ha funcionado. He seguido tus indicaciones, pero al correr la macro me sale un error "se ha producido el error 9 en tiempo de ejecución: subíndice fuera del intervalo."

Creo que la mejor manera es que te paso un ejemplo de mis datos y verás el porqué.

los datos los puedes descargar de este enlace.

https://www.dropbox.com/s/skj7mkb5uoeofp3/EJEMPLO.xlsx?dl=0 

Muchas gracias

Yo no esperaba que te funcionara a la primera, siempre pasa que hacemos las macros y rara vez andan del primer intento.. Siempre es bueno que veamos las hojas, por ejemplo ahora viendo tu hoja, me doy cuenta que la estructura en la columna G es inconsistente, y así mi código no funciona. Por ejemplo, mira esto:

Con ese simple detalle de los espacios, mi código deja de funcionar. Dame unos minutos para encontrar la solución.

Hola de nuevo.

Pues tampoco me he dado cuenta de esta inconsistencia. A ver si hay una solución. 

gracias

La mejor solución siempre es escribir los datos con consistencia. Te lo he arreglado, solo debes asegurarte en el futuro que esos datos tengan consistencia. No se de que otra forma pueda ayudarte.

Video ejemplo de como quedo: Video demo

Aquí esta el archivo, con los datos en G arreglados y la macro un poco modificada, solo tienes que decidir como la vas a ejecutar, no se como quieres hacerlo. Yo la ejecuto directo desde el código porque solo estoy haciendo pruebas.

Descargar el libro

Como veras, ya no pide que ingreses el numero, ahora se pasan todas a sus respectivas hojas de una vez.

De todas formas te pego el código:

Sub TransferData()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim LookFor As String
Dim DATOS As Worksheet: Set DATOS = Sheets("DATOS")
Dim NombreHoja As String
Dim HojaDestino As Worksheet
Dim uF As Long: uF = DATOS.Range("G" & Rows.Count).End(xlUp).Row
Dim nF As Long
Dim rCell As Range, rRng As Range
Set rRng = Range("G2:G" & uF)
Dim RowArr() As Variant
Dim testStr() As String
For Each rCell In rRng.Cells
    testStr() = Split(rCell.Value)
    NombreHoja = testStr(2)
    Set HojaDestino = Sheets(NombreHoja)
    nF = HojaDestino.Range("A" & Rows.Count).End(xlUp).Row + 1
        RowArr() = DATOS.Range(Cells(rCell.Row, 1), Cells(rCell.Row, 9)).Value2
        HojaDestino.Range("A" & nF & ":I" & nF).Value2 = RowArr()
        Erase RowArr
        Set HojaDestino = Nothing
Next rCell
MsgBox "HECHO!", vbInformation, "Ya..."
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Andy

Prueba esta macro, hace un filtro de lo que tenga la celda j1, (por cierto cambie esta referencia porque de dejarla hubiera creado conflictos con la macro), puedes poner una parte de la palabra y la macro filtrara todas aquellas celdas que las contenga para luego copiarlas a la hoja2

Sub filtrar_y_copiar()
valor = Range("j1")
With Range("a2").CurrentRegion
    .AutoFilter 1, "*" & valor & "*"
    .Offset(1).Copy
    With Sheets("hoja2").Range("a2")
        filas = .CurrentRegion.Rows.Count
        If filas = 1 Then .PasteSpecial
        If filas > 1 Then .Rows(filas + 1).PasteSpecial
    End With
    .AutoFilter
    End With
End Sub

Perdona James
Puede que me haya explicado mal y por eso no me ha funcionado.

Te comento con más detalles el problema que tengo.

Quiero copiar ciertas filas de una hoja 1 y pegarlos en una hoja 2. El problema reside en que el criterio de las  filas que quiero copiar desde la hoja 1 no es una condición simple (es decir igual a un valor concreto, o un texto completo de la celda) sino a UNA PARTE del texto de una celda.

Este es un Ejemplo de un celda de la columna que quiero que se verifique.

1. En la Hoja 1, hay una columna (G) que identifica muchos conceptos que se representan con 6 Cifras (390003) y un texto antes y después del número. Las cifras pueden ser por ejemplo 390005, 390007, 390009... etc... : Ejemplo "33-ESAB - 390003 DOCENCIA - CONFERENCIES".
2. La cosa se complica ya que cada mismo numero (en este caso 390003) puede estar asociado a diferentes textos. En el ejemplo el texto después es "DOCENCIA - CONFERENCIES" pero puede ser también "DOCENCIA - COORDINADORS I TFG", "DOCENCIA - CAMPO"... y el texto antes "33-ESAB" pero puede ser "34-MAP", "39-CAP"...
3. De esta Hoja 1, quiero buscar en la calumna G SOLO los valores que contengan por ejemplo 390003 (da igual el texto asociado) y copiar los valores de la fila correspondiente del rango "A" a "I" a la hoja 2 y pegarlos empezando del rango A2 a I2.
   Espero que me hay explicado bien Andy
   Muchísimas Gracias

Creo que tu explicación se haría más entendible si pusieras una imagen de tus datos y una del resultado esperado, desde un punto de vista no veo lo complicado, por ejemplo en esta imagen esta una simulación de lo creo son tus datos, el 390009 tiene diferente principio, 33 esab y 34 map, en cuanto corras la macro pasa esto

la macro lo filtra así, como ves no importa como esta el principio y luego la macro termina así

copiando lo filtrado a la hoja2

Y esta es la macro, la macro igual trabaja con otras partes del texto, peue ser Esab, map, etc, el 7 que ves indica el numero de la columna donde hará el filtro que corresponde a la columna G, también puedes cambiarlo, por cierto de nuevo cambie el rango del valor a filtrar a la celda k1

Sub filtrar_y_copiar()
valor = Range("K1")
With Range("a1").CurrentRegion
    .AutoFilter 7, "*" & valor & "*"
    .Offset(1).Copy
    With Sheets("hoja2").Range("a2")
        filas = .CurrentRegion.Rows.Count
        If filas = 1 Then .PasteSpecial
        If filas > 1 Then .Rows(filas + 1).PasteSpecial
    End With
    .AutoFilter
    End With
End Sub

Hola James,

Las imagnes que pones describen exactamente mi problema. la solución que propones es una de las opciones que pude hacer sin necesidad de hacer una Macro. Únicamente haciendo un "filtro de texto"  con la opción "contiene" el text que quiera, en este caso "390003", me lo soluciona y luego copio y pego.
El problema es que la hoja 1 es una hoja que se actualiza cada día y quiero automatizar el proceso.

gracias de todos modos