Buenos días Foro,

Necesito vuestra ayuda y conocimiento para un error con VBA. Hace un mes que lleva dándome problema una línea de código (no había pasado en más de un año) y tras mirar en mil páginas no encuentro solución, por si pudierais echarme una mano. Os adjunto la línea de código: El error se encuentra en el "end if" del final.

No sabéis lo importante que me es solucionarlo y no encuentro la solución... Mil gracias

Sub ImportarModelos()
    Dim strSource As String
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim consulta As String
    
    Dim archivoAbrir As Excel.Workbook
    Dim RUTAExcel As String
    Dim strRespuesta As String
    
    Dim posicionhoja As Integer
    Dim rangocopiar As Range
    Dim rangopegar As Range
    
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim m As Long
    
    Dim cantcarroc As Long
    Dim matrizcarroc(150) As String
    Dim ETYPE As String
    Dim modelo As String
    Static cantmodelos As String
    Dim planta As String

    Dim numMES1 As Integer
    Dim numMES2 As Integer
    Dim numMES3 As Integer
    Dim numMES4 As Integer
    Dim numMES5 As Integer
    Dim numMES6 As Integer
    Dim numMES7 As Integer
    Dim numMES8 As Integer
    Dim numMES9 As Integer
    Dim numMES10 As Integer
    Dim numMES11 As Integer
    Dim numMES12 As Integer

    Dim StartTime As Double
    Dim MinutesElapsed As String
    
    strRespuesta = MsgBox("La importación de Modelos eliminará todos los datos anteriores. ¿Desea continuar?", _
                    vbQuestion + vbYesNo, "Importación de Modelos")
            
    If strRespuesta = vbNo Then
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
        
    'Colocar ACT y FC en la Plantilla
    Call Etiquetar_FC_ACT

    'Ruta Excel con rutas almacenadas (Excel formulario cargar ficheros)
    RUTAExcel = RutaTool.Range("D2") & "\" & RutaTool.Range("C2")
    Set archivoAbrir = Workbooks.Open(RUTAExcel)
    
    'Ruta bbdd
    With archivoAbrir
        strSource = ActiveSheet.Range("D6").Value & "\" & ActiveSheet.Range("C6").Value
         .Close
    End With
    Set dbs = DBEngine.OpenDatabase(strSource, False, False)
    
    sFechaBotonModelos = "UPDATE Fechas_Modelos SET Fecha_BotonModelos= Now()"
    dbs.Execute sFechaBotonModelos
    

    'Aviso de ejecucion importar datos
    Application.StatusBar = "Importando MODELOS desde Base de Datos"
    
    marca = indice.Range("B10")

    If marca = "TODAS" Then
                                            
        consulta = "SELECT DISTINCT ModelosBD.E_CS " _
        & "FROM ModelosBD " _
        & "WHERE (((ModelosBD.Modelcode) In (SELECT Modelcode FROM [InvoicesAG]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [SOYModel_NSCStock]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [SOYModel_DealerStock]) " _
        & "OR (ModelosBD.modelcode) in (SELECT Modelcode FROM WholesaleVO_CC) " _
        & "OR (ModelosBD.modelcode) in (SELECT Modelcode FROM WholesaleVO_RAC) " _
        & "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM MatriculasCC) " _
        & "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM MatriculasRAC) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [WholesaleTOTAL]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [IncomingORDERS]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [RetailTOTAL])))"
        
    Else
        consulta = "SELECT DISTINCT ModelosBD.E_CS " _
        & "FROM ModelosBD " _
        & "WHERE (((ModelosBD.Brand)='" & marca & "') AND ((ModelosBD.Modelcode) In (SELECT Modelcode FROM [InvoicesAG]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [SOYModel_NSCStock]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [SOYModel_DealerStock]) " _
        & "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM WholesaleVO_CC) " _
        & "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM WholesaleVO_RAC) " _
        & "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM MatriculasCC) " _
        & "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM MatriculasRAC) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [WholesaleTOTAL]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [IncomingORDERS]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [RetailTOTAL])))"
  
    End If

    Set rst = dbs.OpenRecordset(consulta)
    rst.MoveLast
    rst.MoveFirst
    
    cantcarroc = rst.RecordCount
    For i = 1 To cantcarroc
        matrizcarroc(i) = rst.Fields(0)
        rst.MoveNext
    Next i
    
    '** para modelos, elimina todas las hojas y crea nueva por cada carrocería (para WH,RT e IO no elimina hojas)
      
    canthojas = Worksheets.Count
    
    If canthojas > 14 Then
        For m = canthojas To 15 Step -1  'PARA CADA HOJA
            Sheets(m).Delete
        Next
    End If 'canthojas >14
    Sheets(3).Visible = True 'NuevaPlantilla
           
    For m = 1 To cantcarroc
        Sheets(3).Copy after:=Sheets(14) 'copia la hoja Plantilla (oculta)
    Next m
    Sheets(3).Visible = False
    
    For i = 1 To cantcarroc

 

He comprobado si hay al menos un registro obtenido por el conjunto de registros y el caso es que NO hay ningún registro; el error tiene que estar antes de la función MoveLast

 

 la macro lo que realiza es una extracción de datos de meses actuales para poder predecir meses futuros. El mensaje de error que obtengo es el siguiente: "Se ha producido un erorr ´3021´ en el tiempo de ejecución: no hay ningún registro activo" Cuando hace meses que funciona correctamente y nadie ha tocado el código.
 

Todo parece indicar que el recordset está vacio.

Condiciona el proceso por  rst.RecordCount > 0

Hola, ¿en que parte iria dicha linea de codigo? Cual puede ser el motivo que durante un año entero ha funcionado la linea de codigo y ahora no?

Hola

Pues la línea de código podrá ser la misma en un año, pero los datos podrían haber cambiado. Como dice Antoni, se tendría que validar el RecordCount. Podría apostar que el error está en lo que has escrito en la celda B10 de la hoja Índice... Me inclino a pensar que le pusiste espacios en blanco al inicio o final, dejaste la marca en blanco o escribiste una que no existe. Recuerda que si quieres todas las marcas, debes escribir TODAS en lugar de dejarlo en blanco.

Muchas gracias por la respuesta, voy a comprobar a que 100% coincida los datos ¿puedes comentarme el proceso de validar el RecordCount? ¿En que parte de línea de código iría? Muchas gracias de nuevo

.....
.....
Set rst = dbs.OpenRecordset(consulta)
If rst.RecordCount = 0 Then
   MsgBox "No hay información"
   Exit Sub
End If

'Se eliminan estas líneas, no sirven para nada
'rst.MoveLast
'rst.MoveFirst

.....
.....

 

Muchas gracias, pruebo y comento.

Buen día,

Hola Antoni/Diego, finalmente ya he solucionado el error. El hecho por el que no recogía los datos era porque en la BBDD que utilizamos para cargar dichos datos (donde únicamente había 1 hoja con los datos) se había modificado añadiendo otra hoja nueva (alguien del dto había creado la nueva pestaña para un ejercicio), por lo que existían dos hojas en el fichero y la macro como es lógico se "perdia" al encontrar dos hojas y no una. Finalmente he eliminado la hoja que se ha añadido nueva y ahora funciona todo correctamente. Muchas gracias a todos por la ayuda, no sabéis lo que me habeis ayudado haciendo que funcione como antes.