La macro de bucle de Excel termina temprano y necesita mantener los files abiertos para copyr varios loops (files diferentes)

Estoy teniendo un pequeño problema con este código de VBA

Sub upONGOING_Train1() ScreenUpdating = False 'set variables Dim rFndCell As Range Dim strData As String Dim stFnd As String Dim fCol As Integer Dim oCol As Integer Dim SH As Worksheet Dim WS As Worksheet Dim strFName As String Dim objCell As Object Set WS = ThisWorkbook.Sheets("Trains") For Each objCell In WS.Range("L3:L100") oCol = objCell.Column strFName = WS.Cells(, oCol).Offset(objCell.Row - 1, 0) On Error GoTo BLANK: 'skip macro if no train Workbooks.Open Filename:=strFName 'open ongoing report Set SH = Worksheets("Trains") 'set sheet stFnd = WS.Cells(, oCol).Offset(objCell.Row - 1, 2).Value 'set connote With SH Set rFndCell = .Range("C3:C1100").Find(stFnd, LookIn:=xlValues) If Not rFndCell Is Nothing Then fCol = rFndCell.Column WS.Cells(, oCol).Offset(objCell.Row - 1, 3).Resize(1, 6).Copy SH.Cells(, fCol).Offset(rFndCell.Row - 1, 10).Resize(1, 6).PasteSpecial xlPasteValues 'paste values in ongoing report if connote found ActiveWorkbook.Save 'save ongoing report ActiveWorkbook.Close 'close ongoing report Else 'Can't find the item End If End With BLANK: Next objCell ScreenUpdating = True End Sub 

Lo que quiero que haga es – por cada fila en L3: L100

  • Abra el file listdo en la columna "L" (si existe o salte la línea al siguiente) y vaya a la hoja

  • Haga coincidir el valor de la columna de la hoja original "N" con "C3: C1100" en la hoja recién abierta

  • Copie las columnas "O: T" y pegue con relación al valor coincidente en la hoja abierta (M: R) y guarde

Sin embargo, cuando dejo un espacio de 2 filas me da el error de file no encontrado en lugar de proceder al siguiente ciclo como lo hace cuando solo falta 1 fila.

Parece que no puedo publicar imágenes todavía.

Además, si alguien puede indicarme una buena dirección sobre cómo abrir la hoja en la reference de celda solo si aún no está abierta, generalmente solo tendrá 2 files para usar (máximo de 4 al final del trimestre). Es demasiado problema hacer clic en Aceptar en todas las windows que aparecen cuando intenta volver a abrir un libro de trabajo ya abierto.

Si es de alguna ayuda para entenderlo. Tengo 2 informes separados para 2 clientes (nuevos cada trimestre y hasta 4 hojas a la vez) que ya tendrán los nombres para search (2 hojas en cada libro).

Cualquier ayuda sería muy apreciada

Montones de gracias

Gracias a aquellos que han presentado sugerencias y códigos. Los sacaré mañana y, en caso de error, me viene otra idea de que networkingiseñar algún otro código que tenga, pero no me di count, sería de ayuda. El código básicamente copy lo que necesito en una pestaña en blanco y elimina las filas con un valor dado. Con algunas fórmulas para ayudar a orderar esto, me daría un bloque de filas sin interrupciones, todas yendo al mismo file de destino. Esto me permite ejecutar el bucle (un poco más optimizado Gracias a todos ) sobre las filas restantes.

On Error GoTo BLANK

Workbooks.Open Filename:=strFName

Cambie lo anterior a esto:

 On Error Resume Next Workbooks.Open Filename:=strFName If Err.Number <> 0 Then Goto Blank 

En cuanto a hpw, mantenga el libro abierto, puede dejarlo abierto (no .close ) pero luego, cuando quiera abrirlo, compruebe primero si está abierto (es decir, usando Workbooks("name") ), con algún event handling errores usando el mismo mecanismo como el anterior, si el error existe entonces el wb no está abierto, lo abre.

Finalmente, evite contar con el material Active , como ActiveWorkbook`. En cambio, haga una reference explícita a usted wb, es decir:

  Set wb = Workbooks.Open(Filename:=strFName) Set SH = wb.Worksheets("Trains") 

para considerar solo las celdas en blanco, puede utilizar el método SpecialCells () del object Range y dejar fuera cualquier instrucción On Error GoTo , que debería usarse en muy pocos casos (uno de los cuales veremos en un segundo)

además, estás usando algunos 'loops' inútilmente largos para hacer reference a tus celdas relevantes, por ejemplo:

 WS.Cells(, oCol).Offset(objCell.Row - 1, 0) 

es equivalente a objCell mismo!

y hay algunos ejemplos más de ese tipo

finalmente, veamos el tema de abrir / cerrar libros de trabajo

tú podrías:

  • utilice un object de Dictionary para almacenar el nombre de todos los libros abiertos para luego abrir y abrirlos en toda su macro y cerrarlos al final del mismo

  • adopte una function auxiliar que intente establecer la hoja deseada (es decir, "Trenes") en el libro de trabajo deseado (es decir, aquel cuyo nombre es el valor objCell actual) y devuelva False si no tiene éxito

todo lo de arriba en esta refacturación de tu código:

 Sub upONGOING_Train1bis() Dim rFndCell As Range Dim SH As Worksheet Dim objCell As Range Dim shtDict As New Scripting.Dictionary '<--| this is the dictionary that will store every opened workbook name as its 'keys' Dim key As Variant ' Dim dec As String '<--| do you actually need it? Application.ScreenUpdating = False With ThisWorkbook.Sheets("Trains") '<-- reference your working worksheet ' dec = .Range("L1") '<-- what's this for? in any case take it out of for loops since its value doesn't depend on current loop variables For Each objCell In .Range("L3:L100").SpecialCells(xlCellTypeConstants) '<--| loop through L3:L100 range not blank cells only If TrySetWorksheet(objCell.Value, "Trains", SH) Then '<--|Try to set the wanted worksheet in the wanted workbook: if successful it'd retrun 'True' and leave you with 'SH' variable set to the wanted worksheet shtDict(SH.Parent.Name) = shtDict(SH.Parent.Name) + 1 Set rFndCell = SH.Range("C3:C1100").Find(objCell.Offset(, 2).Value, LookIn:=xlValues, lookAt:=xlWhole) '<--| specify at least 'LookIn' and 'LookAt' parameters If Not rFndCell Is Nothing Then rFndCell.Offset(, 10).Resize(, 6).Value = objCell.Offset(, 3).Resize(, 6).Value End If Next objCell End With For Each key In shtDict.Keys '<--|loop through opened workbooks dictionary keys Workbooks(key).Close True '<--| close workbook whose name corresponds to current dictionary key Next Application.ScreenUpdating = True End Sub Function TrySetWorksheet(fileName As String, shtname As String, sht As Worksheet) As Boolean Set sht = Nothing On Error Resume Next Set sht = Workbooks(Right(fileName, Len(fileName) - InStrRev(fileName, "\"))).Worksheets(shtname) '<--| try looking for an already open workbook with wanted name and wanted sheet If sht Is Nothing Then Set sht = Workbooks.Open(fileName:=fileName).Worksheets(shtname) '<--| if not found then try opening the wanted workbook and set the wanted sheet in it TrySetWorksheet = Not sht Is Nothing '<--| set the return value to the final result of attempts at locating the wanted sheet End Function