Como saltarse un error

[jongova]

Tengo el siguiente codigo que me esta causando el error "Object variable or With block variable not set"


El codigo a grandes rasgos lo que hace es que abre un archivo, busca una palabra, cuando la encuentra corta y pega un rango de celdas en otro archivo.


Cuando vuelve a buscar y no encuentra la palabra me sale un error, para lo cual le agregue la instruccion de "On Error GoTo"


Pero no funciona, si alguien me podria ayudar se los agradezco.


Saludos
jongova




Sub AbrirBuscar()
'
'
Dim sPath As String, sName As String
Dim bk As Workbook
On Error GoTo CerrarArchivo
sPath = "D:\Documents\SQ\Licitaciones\2013 MegaLicitacion\TEST\"
sName = Dir(sPath & "*.xls")
Do While sName <> ""
Set bk = Workbooks.Open(sPath & sName)

Cells.Find(what:="BACAL-515 (DES)", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(-3, 0).Range(Cells(1, 1), Cells(62, 11)).Select
Selection.Cut
Windows("Book1").Activate
ActiveSheet.Paste
ActiveCell.Offset(62, 0).Activate
Workbooks(2).Activate


Cells.Find(what:="BACAL-515 (DES)", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(-3, 0).Range(Cells(1, 1), Cells(62, 11)).Select
Selection.Cut
Windows("Book1").Activate
ActiveSheet.Paste
ActiveCell.Offset(62, 0).Activate

CerrarArchivo:
bk.Close Savechanges:=False
sName = Dir()


Loop


End Sub

 

[Jeffrey Smith]

Translated to English:

----------------------------

I have the following code that is causing me the error "Object Variable or With block variable not set"



The code roughly what it does is it opens a file, search for a word, when is cut and paste a range of cells in another file.




When he returns to find and not find the word I get an error, for which we add the instruction "On Error GoTo"




But it does not work, if someone could help me thank you.

 

[Jeffrey Smith]

Can you please tell us what line the error happens.

-----------------------------
¿Podría decirnos cuál es la línea que pasa el error.

 

[Jeffrey Smith]

Jongova,

I altered your code a little. I like declaring all my variables. This code cuts and pastes the ranges without having to activate your original workbook. It also declares ranges for the searches instead of selecting the range. I suspect that there was an error related to multiple workbooks.

----------------------------------------
He modificado el código un poco. Me gusta declarar todos mis variables. Este código corta y pega los rangos sin tener que activar el libro original. También declara rangos para las búsquedas en lugar de seleccionar la gama. Sospecho que hay un error relacionado con varios libros.


Jeff

Sub AbrirBuscar()'
'
Dim sPath As String, sName As String
Dim bk As Workbook
Dim NewSht As Worksheet
Dim TWB As Workbook
Dim TSht As Worksheet
Dim TRng As Range
Dim FRng As Range


'
Set TWB = ActiveWorkbook
Set TSht = TWB.ActiveSheet
Set TRng = TSht.ActiveCell


On Error GoTo CerrarArchivo
sPath = "D:\Documents\SQ\Licitaciones\2013 MegaLicitacion\TEST\"
sName = Dir(sPath & "*.xls")
'
Do While sName <> ""
  Set bk = Workbooks.Open(sPath & sName)
  Set NewSht = bk.ActiveSheet
  
  Set FRng = NewSht.Cells.Find(what:="BACAL-515 (DES)", After:=NewSht.ActiveCell, LookIn:= _
  xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
  xlNext, MatchCase:=False, SearchFormat:=False)
  Set FRng = Range(FRng.Offset(-3, 0), FRng.Offset(59, 10))
  'ActiveCell.Offset(-3, 0).Range(Cells(1, 1), Cells(62, 11)).Select
  FRng.Cut TRng
  'Windows("Book1").Activate
  'ActiveSheet.Paste
  Set TRng = TRng.Offset(62, 0) '  ActiveCell.Offset(62, 0).Activate
  'Workbooks(2).Activate
  
  
  Set FRng = NewSht.Cells.Find(what:="BACAL-515 (DES)", After:=NewSht.ActiveCell, LookIn:= _
  xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
  xlNext, MatchCase:=False, SearchFormat:=False)
  Set FRng = Range(FRng.Offset(-3, 0), FRng.Offset(59, 10))
  'ActiveCell.Offset(-3, 0).Range(Cells(1, 1), Cells(62, 11)).Select
  FRng.Cut TRng
  'Selection.Cut
  'Windows("Book1").Activate
  'ActiveSheet.Paste
  'ActiveCell.Offset(62, 0).Activate
  Set TRng = TRng.Offset(62, 0)
  
CerrarArchivo:
  bk.Close Savechanges:=False
  sName = Dir()




Loop




End Sub

 

[jongova]

Jeff,

El codigo que reescribiste me arroja un error que dice "Method or data member not found y señala la Ln 15, Col 27.

En respuesta a tu primer pregunta, el error me sale cuando el codigo busca por segunda vez la palabra "Bacal", si no la encuentra, ahi es cuando arroja el error. Seria la linea 26

Gracias
Jonathan

 

[Jeffrey Smith]

Jonathan,

When you report an error, please paste the text that is on the line. Ln 15, Col 27 doesn't help because my code may or may not begin at the same place as yours. Please let me know what line of code is giving you an error in the code I gave you.

You are telling me that the second search produces an error, but the error does not Goto CerrarArchivo. That is strange.

I still think it is related to switching (activating) workbooks back and forth.

-------------------------------------
Cuando informa de un error, por favor, pegue el texto que está en la línea. Ln 15, Col 27 no ayuda porque el código puede o no puede comenzar en el mismo lugar que el suyo. Déjeme por favor saber qué línea de código que se está dando un error en el código que te di.


¿Me está diciendo que la segunda búsqueda produce un error, pero el error no se Goto CerrarArchivo. Eso es extraño.


Sigo pensando que tiene que ver con conmutación (activación) libros de ida y vuelta.

Jeff

 

[jongova]

Al ejecutar el codigo que escribiste se produce un error señalando la linea que dice

"Set TRng = TSht.ActiveCell"

y se sombrea AtiveCell

Saludos

 

[Jeffrey Smith]

Jonathan,

Got it! I changed the code a little. Try using this. Remember, this is a work in progress because I'm working blind and can't run the code on my end.

-------------------------
¡Gracias! He cambiado el código un poco. Trate de usar esto. Recuerde que este es un trabajo en progreso porque estoy trabajando a ciegas y no puede ejecutar el código en mi final.


Jeff

Sub AbrirBuscar()'
'
Dim sPath As String, sName As String
Dim bk As Workbook
Dim NewSht As Worksheet
Dim TWB As Workbook
Dim TSht As Worksheet
Dim TRng As Range
Dim FRng As Range
Dim NewRng As Range


'
Set TWB = ActiveWorkbook
Set TSht = TWB.ActiveSheet
Set TRng = ActiveCell


On Error GoTo CerrarArchivo
sPath = "D:\Documents\SQ\Licitaciones\2013 MegaLicitacion\TEST\"
sName = Dir(sPath & "*.xls")
'
Do While sName <> ""
  Set bk = Workbooks.Open(sPath & sName)
  Set NewSht = bk.ActiveSheet
  Set NewRng = ActiveCell
  
  Set FRng = NewSht.Cells.Find(what:="BACAL-515 (DES)", After:=NewRng, LookIn:= _
  xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
  xlNext, MatchCase:=False, SearchFormat:=False)
  Set FRng = Range(FRng.Offset(-3, 0), FRng.Offset(59, 10))
  'ActiveCell.Offset(-3, 0).Range(Cells(1, 1), Cells(62, 11)).Select
  FRng.Cut TRng
  'Windows("Book1").Activate
  'ActiveSheet.Paste
  Set TRng = TRng.Offset(62, 0) '  ActiveCell.Offset(62, 0).Activate
  'Workbooks(2).Activate
  
  
  Set FRng = NewSht.Cells.Find(what:="BACAL-515 (DES)", After:=NewRng.ActiveCell, LookIn:= _
  xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
  xlNext, MatchCase:=False, SearchFormat:=False)
  Set FRng = Range(FRng.Offset(-3, 0), FRng.Offset(59, 10))
  'ActiveCell.Offset(-3, 0).Range(Cells(1, 1), Cells(62, 11)).Select
  FRng.Cut TRng
  'Selection.Cut
  'Windows("Book1").Activate
  'ActiveSheet.Paste
  'ActiveCell.Offset(62, 0).Activate
  Set TRng = TRng.Offset(62, 0)
  
CerrarArchivo:
  bk.Close Savechanges:=False
  sName = Dir()




Loop




End Sub

 

[jongova]

Jeff,

Use el codigo que me diste, al ejecutar el codigo por segunda vez sucedio un error en la parte donde dice "FRng.Cut TRng" y el error decia Object Required.

Jeff, si quieres podemos dejar hasta aqui la solucion, me compartieron otro codigo y funciona bien.

Muchas gracias por tu ayuda y tu tiempo, de verdad que lo aprecio.

Saludos
Jonathan

 

[Jeffrey Smith]

Jonathan,

If you want to keep on trying, here is another version:
-------------------------
Si quieres seguir intentando, aquí está otra versión

Sub AbrirBuscar()'
'
Dim sPath As String, sName As String
Dim bk As Workbook
Dim NewSht As Worksheet
Dim TWB As Workbook
Dim TSht As Worksheet
Dim TRng As Range
Dim FRng As Range
Dim NewRng As Range


'
Set TWB = ActiveWorkbook
Set TSht = TWB.ActiveSheet
Set TRng = ActiveCell


On Error GoTo CerrarArchivo
sPath = "D:\Documents\SQ\Licitaciones\2013 MegaLicitacion\TEST\"
sName = Dir(sPath & "*.xls")
'
Do While sName <> ""
  Set bk = Workbooks.Open(sPath & sName)
  Set NewSht = bk.ActiveSheet
  Set NewRng = ActiveCell
  
  Set FRng = NewSht.Cells.Find(what:="BACAL-515 (DES)", After:=NewRng, LookIn:= _
  xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
  xlNext, MatchCase:=False, SearchFormat:=False)
  Set FRng = Range(FRng.Offset(-3, 0), FRng.Offset(59, 10))
  'ActiveCell.Offset(-3, 0).Range(Cells(1, 1), Cells(62, 11)).Select
  FRng.Cut TSht.TRng
  'Windows("Book1").Activate
  'ActiveSheet.Paste
  Set TRng = TSht.TRng.Offset(62, 0) '  ActiveCell.Offset(62, 0).Activate
  'Workbooks(2).Activate
  
  
  Set FRng = NewSht.Cells.Find(what:="BACAL-515 (DES)", After:=NewRng.ActiveCell, LookIn:= _
  xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
  xlNext, MatchCase:=False, SearchFormat:=False)
  Set FRng = Range(FRng.Offset(-3, 0), FRng.Offset(59, 10))
  'ActiveCell.Offset(-3, 0).Range(Cells(1, 1), Cells(62, 11)).Select
  FRng.Cut TSht.TRng
  'Selection.Cut
  'Windows("Book1").Activate
  'ActiveSheet.Paste
  'ActiveCell.Offset(62, 0).Activate
  Set TSht.TRng = TRng.Offset(62, 0)
  
CerrarArchivo:
  bk.Close Savechanges:=False
  sName = Dir()




Loop




End Sub