Hola el programa lo que hace es recoger cada linea de un data (recordset) y los va pegando en hojas de excel segun si en la hoja actual en tal celda existe un valor en concreto entonces lo pegas en esa hoja sino pasas a la siguiente hoja y sigues buscando, hasta el final de los registros...
consulta4 = "select * from lista where lista.[Réf Cde client]='IMP' and lista.[Exportado]=0;"
Data5.RecordSource = consulta4
Data5.Refresh
If Data5.Recordset.RecordCount <> 0 Then
'Crear fichero IMPx.xls
Application.DisplayAlerts = False
nombre = crear_ruta(2)
nombre = nombre & "imp" & nficheroimp & ".xls"
If Dir(nombre) = "" Then
Application.Workbooks.Open App.Path & "\mdb\plantilla.xls"
Application.Visible = False
nombre = crear_ruta(2)
nombre = nombre & "imp" & nficheroimp & ".xls"
Application.ActiveWorkbook.SaveAs nombre
Application.Quit
Else
'nada
End If
Application.Workbooks.Open nombre
Application.Visible = False
nhojas = Application.Worksheets.Count
Application.ActiveWorkbook.Close
Application.Quit
Do While Not Data5.Recordset.EOF
For cont = 0 To 6
campos(cont) = Data5.Recordset.Fields(cont)
Next
'Buscar cliente y pegar datos
For ihojas = 2 To nhojas 'empieza en 2 para saltarse la primera que es la plantilla
Application.Workbooks.Open nombre
Application.Visible = False
Application.Worksheets(ihojas).Activate
nomhojas = Application.ActiveSheet.Name
rangoB = "B"
compara = Application.Worksheets(nomhojas).Cells(fila, rangoB).Value
'compara = compara & " "
archivo = Split(compara, " ")
archivo2 = Split(campos(1), " ")
If archivo(0) = archivo2(0) Then
'If compara = campos(1) Then
rangoG = "G"
If Application.Worksheets(nomhojas).Cells(fila, rangoG).Value = "" Then
'Pegar datos
rangoA = "A"
Application.Worksheets(nomhojas).Cells(fila, rangoA).Value = campos(0)
Text1.Text = campos(0)
rangoB = "B"
Application.Worksheets(nomhojas).Cells(fila, rangoB).Value = campos(1)
Text2.Text = campos(1)
rangoC = "C"
Application.Worksheets(nomhojas).Cells(fila, rangoC).Value = campos(6)
Text7.Text = campos(6)
rangoD = "D"
Application.Worksheets(nomhojas).Cells(fila, rangoD).Value = campos(2)
Text3.Text = campos(2)
rangoE = "E"
Application.Worksheets(nomhojas).Cells(fila, rangoE).Value = campos(3)
Text4.Text = campos(3)
rangoF = "F"
Application.Worksheets(nomhojas).Cells(fila, rangoF).Value = "1"
Text5.Text = "1"
rangoG = "G"
Application.Worksheets(nomhojas).Cells(fila, rangoG).Value = campos(5)
Text6.Text = campos(5)
Text8.Text = "IMP"
Data5.Recordset.Edit
Data5.Recordset.Fields(7) = 1
Application.ActiveWorkbook.Save
Application.ActiveWorkbook.Close
Application.Quit
ElseIf Application.Worksheets(nomhojas).Cells(fila, rangoG).Value <> "" Then
If Application.Worksheets(nomhojas).Cells(fila, rangoG).Value = campos(6) Then 'antes (6)
'Nada
ElseIf Application.Worksheets(nomhojas).Cells(fila, rangoG).Value <> campos(6) Then
fila = fila + 1
rangoG = "G" & fila & ""
Application.Range(rangoG).EntireRow.Insert
'Pegar datos
rangoA = "A"
Application.Worksheets(nomhojas).Cells(fila, rangoA).Value = campos(0)
Text1.Text = campos(0)
rangoB = "B"
Application.Worksheets(nomhojas).Cells(fila, rangoB).Value = campos(1)
Text2.Text = campos(1)
rangoC = "C"
Application.Worksheets(nomhojas).Cells(fila, rangoC).Value = campos(6)
Text7.Text = campos(6)
rangoD = "D"
Application.Worksheets(nomhojas).Cells(fila, rangoD).Value = campos(2)
Text3.Text = campos(2)
rangoE = "E"
Application.Worksheets(nomhojas).Cells(fila, rangoE).Value = campos(3)
Text4.Text = campos(3)
rangoF = "F"
Application.Worksheets(nomhojas).Cells(fila, rangoF).Value = "1"
Text5.Text = "1"
rangoG = "G"
Application.Worksheets(nomhojas).Cells(fila, rangoG).Value = campos(5)
Text6.Text = campos(5)
Text8.Text = "IMP"
Data5.Recordset.Edit
Data5.Recordset.Fields(7) = 1
Data5.Recordset.Update
Application.ActiveWorkbook.Save
Application.ActiveWorkbook.Close
Application.Quit
End If
End If
End If
Next 'recorrer hojas del libro
Data5.Recordset.MoveNext
Loop
'Guardar el fichero nuevo
'Application.ActiveWorkbook.Save
'Application.Quit
Data5.Refresh
Else
nficheroimp = nficheroimp + 1
End If
Me da error en la instruccion:
Application.Worksheets(nomhojas).Cells(fila, rangoE).Value = campos(3)
pero del ElseIf
ElseIf Application.Worksheets(nomhojas).Cells(fila, rangoG).Value <> "" Then
no el primero que hace...
pero no en la primera pasada sino cuando ya lleva varias hojas miradas y procesadas entonces me da el error.
Autor
En línea
