Buble de 100 registros y añadir hoja nueva

Pues eso quiero hacer un bucle que me añada 50 registros y que cuando

a los 38 me añada una segunda hoja y en esta hoja me añada 12 registros
mas, los primeros 38 me lo hace perfecto pero cuando añado la segunda hoja
no me escribe en la segunda lo hace en la primera, me parece que tiene que
ser algo de activar la hoja 2 pero no se como decirselo.
haber si alguien me ayuda, gracias.

Sub test()
Const sArchivosTemporales As String = "C:\Temp"
Dim Fila As Long
Dim Columna As Long
Dim i As Integer, nRegistros As Long
Dim rsOrigen As ADODB.Recordset
Dim sCarpetaActual As String, sArchivo As String

Dim ExcApp As Excel.Application
Dim ExcWBook As Excel.Workbook
Dim ExcWSheet As Excel.Worksheet

sCarpetaActual = CurrentProject.Path
sArchivo = "Pedidos email.xls"



Set rsOrigen = New ADODB.Recordset 'Creacion
rsOrigen.Open "mitabla", CurrentProject.Connection, adOpenKeyset,
adLockOptimistic

Set ExcApp = CreateObject("Excel.Application")
ExcApp.Visible = True 'La hacemos visible pa que la peña flipe
Set ExcWBook = ExcApp.Workbooks.Open(sCarpetaActual & "\" & sArchivo)
'Cargamos el fichero del año en curso

Set ExcWSheet = ExcWBook.ActiveSheet 'Cargamos la hoja activa

Columna = 1
Fila = 9

With ExcApp.ActiveSheet
Do While Not rsOrigen.EOF
i = i + 1
Debug.Print ExcApp.ActiveSheet.Name
If i <= 38 Then
.Unprotect
.Cells(Fila + i, Columna) = rsOrigen!id1
.Cells(Fila + i, Columna + 1) = rsOrigen!id1

If IsNull(rsOrigen!id1) Then
.Cells(Fila + i, Columna + 5) = ""
Else
.Cells(Fila + i, Columna + 5) > CDate(rsOrigen![id1])
End If

.Cells(Fila + i, Columna + 7) = rsOrigen!id1
.Cells(Fila + i, Columna + 8) = IIf((rsOrigen!id1 0),
"", CCur(rsOrigen!id1))
.Cells(Fila + i, Columna + 9) = IIf((Nz(rsOrigen!id1,

* 100 = 0), "", rsOrigen!id1 * 100)
rsOrigen.Delete

Else 'Si es mayor que 38 significa que hoja nueva

Dim Hojas As Excel.Worksheet
Dim X As Integer
Dim booExisteHoja As Boolean

booExisteHoja = True: X = 1
Do

With ExcWBook
For Each Hojas In .Worksheets
If Mid(Hojas.Name, 5, Len(Hojas.Name)) = X

booExisteHoja = True
X = X + 1
Else
booExisteHoja = False
.Worksheets("Hoja1").Copy
after:=.Worksheets("Hoja1")
.ActiveSheet.Name = "Hoja" & X
.ActiveSheet.Range("A10:K47").Select
Selection.ClearContents
End If
Next
End With
Loop Until booExisteHoja = False
i = 0 'Reseteamos el contador
End If
rsOrigen.MoveNext
Loop
End With


End Sub

Hola Manolito:

Por lo que veo (en un vistazo rapido), en tu bucle tienes:

With ExcApp.ActiveSheet
''' y cuando accedes a las celdas usas el calificador '.'
.Cells(Fila + i, Columna) = rsOrigen!id1
End With

Por lo que el problema puede estar ahi... aunque dentro del 'With' cambies
la hoja activa, la referencia no se debe actualizar (supongo).

Prueba a cambiarlo guardando en una variable WorkSheet la hoja
sobre la que quieres trabajar, y al crear una nueva hoja, actualizas la
variable:

Set oShActiva = ExcApp.ActiveSheet
Do ...
oShActiva.Cells(Fila + i, Columna) = rsOrigen!id1
...
If i > 38 then
''' Creas la nueva hoja y la dejas activa.
Set oShActiva = ExcApp.ActiveSheet
Endif
Loop

Saludos

"Manolito" escribió en...
> Pues eso quiero hacer un bucle que me añada 50 registros y que cuando
llegue
> a los 38 me añada una segunda hoja y en esta hoja me añada 12 registros
> mas, los primeros 38 me lo hace perfecto pero cuando añado la segunda

> no me escribe en la segunda lo hace en la primera, me parece que tiene

> ser algo de activar la hoja 2 pero no se como decirselo.
> haber si alguien me ayuda, gracias.
>
> Sub test()
> Const sArchivosTemporales As String = "C:\Temp"
> Dim Fila As Long
> Dim Columna As Long
> Dim i As Integer, nRegistros As Long
> Dim rsOrigen As ADODB.Recordset
> Dim sCarpetaActual As String, sArchivo As String
>
> Dim ExcApp As Excel.Application
> Dim ExcWBook As Excel.Workbook
> Dim ExcWSheet As Excel.Worksheet
>
> sCarpetaActual = CurrentProject.Path
> sArchivo = "Pedidos email.xls"
>
>
>
> Set rsOrigen = New ADODB.Recordset 'Creacion
> rsOrigen.Open "mitabla", CurrentProject.Connection, adOpenKeyset,
> adLockOptimistic
>
> Set ExcApp = CreateObject("Excel.Application")
> ExcApp.Visible = True 'La hacemos visible pa que la peña flipe
> Set ExcWBook = ExcApp.Workbooks.Open(sCarpetaActual & "\" &

> 'Cargamos el fichero del año en curso
>
> Set ExcWSheet = ExcWBook.ActiveSheet 'Cargamos la hoja activa
>
> Columna = 1
> Fila = 9
>
> With ExcApp.ActiveSheet
> Do While Not rsOrigen.EOF
> i = i + 1
> Debug.Print ExcApp.ActiveSheet.Name
> If i <= 38 Then
> .Unprotect
> .Cells(Fila + i, Columna) = rsOrigen!id1
> .Cells(Fila + i, Columna + 1) = rsOrigen!id1
>
> If IsNull(rsOrigen!id1) Then
> .Cells(Fila + i, Columna + 5) = ""
> Else
> .Cells(Fila + i, Columna + 5) > > CDate(rsOrigen![id1])
> End If
>
> .Cells(Fila + i, Columna + 7) = rsOrigen!id1
> .Cells(Fila + i, Columna + 8) = IIf((rsOrigen!id1 > 0),
> "", CCur(rsOrigen!id1))
> .Cells(Fila + i, Columna + 9) IIf((Nz(rsOrigen!id1,
0)
> * 100 = 0), "", rsOrigen!id1 * 100)
> rsOrigen.Delete
>
> Else 'Si es mayor que 38 significa que hoja nueva
>
> Dim Hojas As Excel.Worksheet
> Dim X As Integer
> Dim booExisteHoja As Boolean
>
> booExisteHoja = True: X = 1
> Do
>
> With ExcWBook
> For Each Hojas In .Worksheets
> If Mid(Hojas.Name, 5, Len(Hojas.Name)) = X
Then
> booExisteHoja = True
> X = X + 1
> Else
> booExisteHoja = False
> .Worksheets("Hoja1").Copy
> after:=.Worksheets("Hoja1")
> .ActiveSheet.Name = "Hoja" & X
> .ActiveSheet.Range("A10:K47").Select
> Selection.ClearContents
> End If
> Next
> End With
> Loop Until booExisteHoja = False
> i = 0 'Reseteamos el contador
> End If
> rsOrigen.MoveNext
> Loop
> End With
>
>
> End Sub