Macros Para Extraer Información de una Hoja y Copiarla en otra en la siguiente fila disponible.

[filirojas]

Hola, soy nuevo en éste asunto de Visual Basic,
intento extraer información de una hoja de excel a otra, y cuando existan datos en la segunda que me los copie a la siguiente fila disponible:
Hoja Fuente: Este es el documento origen y el documento destino es exactamente igual. Mi problema es copiar la información a la siguiente fila ROW disponible.
Gracias.
[TABLE="width: 318"]
<tbody>[TR]
[TD="class: xl66, width: 64, bgcolor: transparent"]N° Cta
[/TD]
[TD="class: xl66, width: 136, bgcolor: transparent"]Nombre
[/TD]
[TD="class: xl66, width: 75, bgcolor: transparent"]Fecha
[/TD]
[TD="class: xl67, width: 74, bgcolor: transparent"] Debe
[/TD]
[TD="class: xl66, width: 74, bgcolor: transparent"]Haber
[/TD]
[/TR]
[TR]
[TD="class: xl66, bgcolor: transparent"]100-000
[/TD]
[TD="class: xl68, bgcolor: transparent"]Caja y Bancos
[/TD]
[TD="class: xl69, bgcolor: transparent, align: right"]10/30/2012
[/TD]
[TD="class: xl70, bgcolor: transparent"] $ 1,000.00
[/TD]
[TD="class: xl70, bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl66, bgcolor: transparent"]200-000
[/TD]
[TD="class: xl68, bgcolor: transparent"]Acreedores Diversos
[/TD]
[TD="class: xl69, bgcolor: transparent, align: right"]10/30/2012
[/TD]
[TD="class: xl70, bgcolor: transparent"][/TD]
[TD="class: xl70, bgcolor: transparent"] $ 1,000.00
[/TD]
[/TR]
</tbody>[/TABLE]

 

[Greg Truby]

Bienvenido filirojas. En general pregunto a la gente ¿qué ha hecho en términos de un intento para hacer la programación sí mismo? En este caso, dado que es su primer post aquí le estoy solamente dando una programita que hace lo que usted describe. Favor revise el código y estúdielo para ver como funciona.

'// el código aquí se supone que ambas hojas están en
'// el mismo cuaderno.

Sub CopiarDatos()

    '// si la esquina superior izquierda de los datos
    '// no es A1, ajuste la dirección que se encuentra
    '// aquí.  ¡OJO! Si hay datos contiguos a la izquierda
    '// (o derecha) esta rutina copiará todos.
    Const c_strDirEsqSupIzq_Blanco As String = "A1", _
          c_strDirEsqSupIzq_Fuente As String = "A1"

    Dim rngBlanco   As Excel.Range, _
        rngFuente   As Excel.Range, _
        wksBlanco   As Excel.Worksheet, _
        wksFuente   As Excel.Worksheet
    
    '// usted necesita poner los nombres de las
    '// hojas en el cuaderno de usted aquí
    
    Set wksBlanco = ThisWorkbook.Worksheets("Sheet2")
    Set wksFuente = ThisWorkbook.Worksheets("Sheet1")
    Set rngFuente = wksFuente.Range(c_strDirEsqSupIzq_Fuente).CurrentRegion
    
    '// no habían datos, solo la cabeza
    If rngFuente.Rows.Count = 1 Then Exit Sub
        
    Set rngBlanco = wksBlanco.Range(c_strDirEsqSupIzq_Blanco)
    
    With wksBlanco
        Set rngBlanco = .Cells(.Rows.Count, rngBlanco.Column).End(xlUp)
    End With
    
    If rngBlanco.Row = wksBlanco.Range(c_strDirEsqSupIzq_Blanco).Row Then
        '// no hacemos nada más con los rangos de fuente
        '// y blanco porque no hay cabezas en la hoja blanco
    Else
        '// sí, ya hay cabezas en el blanco entonces tenemos
        '// que ajustar ambos rangos
        
        '// quitamos la fila de cabezas del rango fuente
        With rngFuente
            Set rngFuente = .Offset(1, 0).Resize(.Rows.Count - 1)
        End With
    
        '// bajamos la fila del blanco una fila
        With rngBlanco
            Set rngBlanco = .Offset(1)
        End With
    End If
    
    rngFuente.Copy rngBlanco
    
    Application.CutCopyMode = False
    
End Sub '// fin de CopiarDatos()

Saludos,

Greg

 

[filirojas]

Gracias Greg,
Voy a intentarlo en un rato más, de hecho hice la MACRO manualmente, (copy-paste), sólo me falta la parte de ir a la siguiente fila vacía, estoy utilizando Excel 2010 - Versión Inglés, no sé si los Macros en español funcionen igual.
Te agradezco la información.
Saludos de Tecate, México.

 

[filirojas]

Estimado Greg,

Copie el Código-Macro en un par de hojas nuevas de EXCEL, corrí varios ejemplos de CAPTURA, y "FUNCIONA A LA PERFECCIÓN", Gracias de nuevo por tú ayuda.
En caso de quel renombre mis Hojas, (aún no lo hago), supongo debo renombrarlas también en la Macro Correspondiente, yo lo intentaré, lo complicado ya me proveiste solución.
Saludos de nuevo,

 

[Greg Truby]

...En caso de quel renombre mis Hojas, (aún no lo hago), supongo debo renombrarlas también en la Macro Correspondiente

Bueno - una estructura mejor sería sacar los nombres de las hojas y ponerlos como constantes al inicio de la rutina y si tiene que cambiar los nombres es más fácil. Uno cambia los valores de los constantes y no tiene que estar buscando cada instancia de cada nombre. En el caso de esta rutina es muy sencilla y los nombre solamente se aparecen una vez. Pero en caso de una rutina mucho más complicado se hace la vida mucho más fácil usar constantes.

'// el código aquí se supone que ambas hojas están en
'// el mismo cuaderno.

Sub CopiarDatos()

    '// si la esquina superior izquierda de los datos
    '// no es A1, ajuste la dirección que se encuentra
    '// aquí.  ¡OJO! Si hay datos contiguos a la izquierda
    '// (o derecha) esta rutina copiará todos.
    Const c_strDirEsqSupIzq_Blanco As String = "A1", _
          c_strDirEsqSupIzq_Fuente As String = "A1", _
          c_strNombreHoja_Blanco As String = "Sheet2", _
          c_strNombreHoja_Fuente As String = "Sheet1"
          
    Dim rngBlanco   As Excel.Range, _
        rngFuente   As Excel.Range, _
        wksBlanco   As Excel.Worksheet, _
        wksFuente   As Excel.Worksheet
     
    '// usted necesita poner los nombres de las
    '// hojas en el cuaderno de usted aquí
     
    Set wksBlanco = ThisWorkbook.Worksheets(c_strNombreHoja_Blanco)
    Set wksFuente = ThisWorkbook.Worksheets(c_strNombreHoja_Fuente)
    Set rngFuente = wksFuente.Range(c_strDirEsqSupIzq_Fuente).CurrentRegion
     
    '// no habían datos, solo la cabeza
    If rngFuente.Rows.Count = 1 Then Exit Sub
         
    Set rngBlanco = wksBlanco.Range(c_strDirEsqSupIzq_Blanco)
     
    With wksBlanco
        Set rngBlanco = .Cells(.Rows.Count, rngBlanco.Column).End(xlUp)
    End With
     
    If rngBlanco.Row = wksBlanco.Range(c_strDirEsqSupIzq_Blanco).Row Then
        '// no hacemos nada más con los rangos de fuente
        '// y blanco porque no hay cabezas en la hoja blanco
    Else
        '// sí, ya hay cabezas en el blanco entonces tenemos
        '// que ajustar ambos rangos
         
        '// quitamos la fila de cabezas del rango fuente
        With rngFuente
            Set rngFuente = .Offset(1, 0).Resize(.Rows.Count - 1)
        End With
     
        '// bajamos la fila del blanco una fila
        With rngBlanco
            Set rngBlanco = .Offset(1)
        End With
    End If
     
    rngFuente.Copy rngBlanco
     
    Application.CutCopyMode = False
     
End Sub '// fin de CopiarDatos()

 

[filirojas]

Gracias De Nuevo Greg:

Renombre mis hojas y renombre el dato en la MACRO, funciona perfectamente bien, sólo necesito adecuarle otros datos en ambas hojas y creo que quedará listo, conservo éste nuevo dato para un futuro.
Gracias y Saludos, Keep Up The Good Work.....

 

[Miguel29112]

Hola Gred, excelente la ayuda con esta macro, ya la puede utilizar en mi trabajo, pero como recién estoy aprendiendo quisiera por favor si me ayudas para que la macro me copie con pegado especial de valores, ya que me extrae los datos de las otras hojas con formulas y formatos, espero se pueda, muchas gracias.

Saludos