Excel - Abrir,Buscar y Copiar de otro libro

   
Vista:

Abrir,Buscar y Copiar de otro libro

Publicado por Catalina Zarate O (14 intervenciones) el 18/09/2010 10:24:06
Hola Amigos, tengo un problema que no consigo resolver. A continuacion les explico el dolor de cabeza.

Tengo 2 libros: Control Carga.xls Maestra control de carga C.D.xls

Tengo abierto el libro Control Carga.xls y a traves de un evento en un command button debe abrir el libro Maestra control de carga C.D.xls y buscar todas las patentes
de la columna B de Control Carga.xls (Hoja1) en la columna C de Maestra control de carga C.D.xls (IMPRESION C.D.), de encontrarla copiar concatenadas las celdas de las columnas N, O, P, Q y R y pegarlas en la columna J de Control Carga.xls (Hoja1).

El error que me envia es "subindice fuera del intervalo". en este parrafo.

If LCase(Workbooks("Control Carga.xls").Worksheets("Hoja1").Cells(Fila, 2).Value) = _
LCase(oLibro.Worksheets("IMPRESION C.D.").Cells(Fila1, 3).Value) Then

Este es el codigo completo.

Private Sub CommandButton1_Click()
Dim strArchivo As String
Dim oLibro As Workbook
Dim Fila1&, Fila&
'===========================
'Creamos la variable de la ruta
strArchivo = "C:\Users\Catita\Desktop\Control transp\Maestra control de carga C.D.xls"

'Worksheets("Control Carga").Range("J8:J135").Value = Empty

'Comprobamos si el archivo existe en la ruta indicada
If Dir(strArchivo) = "" Then
MsgBox "No existe el archivo en la ruta indicada."
Exit Sub
End If

'Deshabilitamos la actualizacion de pantalla
Application.ScreenUpdating = False

'Comprobamos si el libro ya esta abierto,
'y, si no lo esta, lo abrimos

'Deshabilitamos los avisos de error
On Error Resume Next

'Intentamos asignar a la variable un libro
'abierto con el nombre que buscamos
Set oLibro = Workbooks(Dir(strArchivo))

'Habilitamos los avisos de error
On Error GoTo 0

'Si la variable no tiene nada asignado
'le asignamos el libro abriendolo directamente
If oLibro Is Nothing Then Set oLibro = Workbooks.Open(strArchivo)

For Fila = 9 To 130

For Fila1 = 3 To 130
If LCase(Workbooks("Control Carga.xls").Worksheets("Hoja1").Cells(Fila, 2).Value) = _
LCase(oLibro.Worksheets("IMPRESION C.D.").Cells(Fila1, 3).Value) Then

LCase(Workbooks("Control Carga.xls").Worksheets("Hoja1").Cells(Fila, 10).Value) = _
LCase(oLibro.Worksheets("IMPRESION C.D.").Cells(Fila1, 14).Value) & _
LCase(oLibro.Worksheets("IMPRESION C.D.").Cells(Fila1, 15).Value) & _
LCase(oLibro.Worksheets("IMPRESION C.D.").Cells(Fila1, 16).Value) & _
LCase(oLibro.Worksheets("IMPRESION C.D.").Cells(Fila1, 17).Value)

End If
Next Fila1
Next Fila

'Cerramos sin guardar cambios
oLibro.Close False

'Vaciamos la variable
Set oLibro = Nothing

'Habilitamos la actualizacion de pantalla
Application.ScreenUpdating = True

End Sub

Atte.

Catita
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

RE:Abrir,Buscar y Copiar de otro libro

Publicado por Catita (14 intervenciones) el 23/09/2010 14:26:24
Esto es, el aporte de JuanC

Private Sub CommandButton1_Click()
Dim strArchivo As String
Dim oLibro As Workbook
Dim Fila1&, Fila&
Dim WS, WS1 As Worksheet
'===========================
'Creamos la variable de la ruta
strArchivo = "C:\Users\Catita\Desktop\Control transp\Maestra control de carga C.D.xls"

'Comprobamos si el archivo existe en la ruta indicada
If Dir(strArchivo) = "" Then
MsgBox "No existe el archivo en la ruta indicada."
Exit Sub
End If

'Deshabilitamos la actualizacion de pantalla
Application.ScreenUpdating = False

'Comprobamos si el libro ya esta abierto,
'y, si no lo esta, lo abrimos

'Deshabilitamos los avisos de error
On Error Resume Next

'Intentamos asignar a la variable un libro
'abierto con el nombre que buscamos
Set oLibro = Workbooks(Dir(strArchivo))

'Habilitamos los avisos de error
On Error GoTo 0

'Si la variable no tiene nada asignado
'le asignamos el libro abriendolo directamente
If oLibro Is Nothing Then Set oLibro = Workbooks.Open(strArchivo)

Set WS = oLibro.Worksheets("IMPRESION C.D.")
Set WS1 = Workbooks("Control Carga.xls").Worksheets("Hoja1")

For Fila = 9 To 130
If UCase(WS1.Cells(Fila, 2).Value) <> Empty Then
If UCase(WS1.Cells(Fila, 2).Value) <> "PATENTE" Then
For Fila1 = 3 To 130
If UCase(WS1.Cells(Fila, 2).Value) = UCase(WS.Cells(Fila1, 3).Value) Then
With WS
WS1.Cells(Fila, 1).Value = UCase(.Cells(Fila1, 2).Value)
WS1.Cells(Fila, 3).Value = .Cells(Fila1, 4).Value
WS1.Cells(Fila, 4).Value = .Cells(Fila1, 5).Value
s = .Cells(Fila1, 14).Value & " " & _
.Cells(Fila1, 15).Value & " " & _
.Cells(Fila1, 16).Value & " " & _
.Cells(Fila1, 17).Value & " " & _
.Cells(Fila1, 18).Value
End With
WS1.Cells(Fila, 10).Value = UCase(s)
End If
Next Fila1
End If
End If
Next Fila

'Cerramos sin guardar cambios
oLibro.Close False

'Vaciamos la variable
Set oLibro = Nothing

'Habilitamos la actualizacion de pantalla
Application.ScreenUpdating = True

End Sub

Gracias JuanC.

Atte.

Catita
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar