Exportar informes a otro libro excel
Para Dante amor.
Tengo la siguiente tabla dinámica con varios usuarios y cada usuario tiene varios datos dentro. Todos esos datos los quiero pasar a otros archivos excel con el nombre de cada usuario y cada archivo contendrá los datos que están en la tabla dinámica por usuario. Es decir que tendré una archivo 101.xlsx con sus datos correspondientes, otro con 102.xlsx y sus datos. Así sucesivamente.
Necesito saber por qué me da error en el siguiente código que está en negrita.
Sub Generar_informes()
Dim i As Double
Dim Ini As Double
Dim Fin As Double
'Desactivamos actualización de pantalla
Application.ScreenUpdating = False
Sheets("TABLA").Select
With Sheets("TABLA")
'indicamos la fila siguiente a la primera fila con datos, (101)
Ini = Columns(1).Range("A1").End(xlDown).Row
'Contamos los todos los usuarios de la tabla dinámica
Fin = .PivotTables(1).PivotFields("U.L.").PivotItems.Count
'Inciamos un bucle donde por cada usuario generamos informe (ShowDetail)
For i = 1 To Fin
'para mostrar el informe debemos hacer referencia a los campos de valores (DIRECCIONES),
.Cells(i + Ini, 2).ShowDetail = True
'Nombramos la pestaña con el nombre de los usuarios
Sheets(1).Name = .Cells(i + Ini, 1).Value
'Seleccionamos la hoja con el detalle de los usuarios
ActiveSheet.Select
'Movemos la hoja a un libro nuevo
ActiveSheet.Move
Application.DisplayAlerts = False
'Guardamos la hoja con el nombre de los usuarios correspondientes y cerramos libro
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Name
ActiveWorkbook.Close False
Next i
End With
Application.ScreenUpdating = True
End Sub
He cogido el código de otro lado y he intentado adaptarlo.
1 Respuesta
Envíame tu archivo con los datos originales, también me anexas otros 2 archivos de excel con 2 usuarios como ejemplo para ver cómo quieres la salida.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Sra Arocha” y el título de esta pregunta.
¡Gracias! Perdón por tardar tanto,voy a tener que dejar este tema y ya lo haré por "combinación de correspondencia en word",si se puede.ahora mismo me urgen otro tipo de cosas a ver si las puedo automatizar.
Esta macro crea los documentos de word pero no utiliza propiamente la correspondencia de word, lo que hace, es tomar tu documento de word y crear un documento por cada nombre que tengas en tu lista de excel.
Sigue los siguientes pasos:
1. Crear tu lista en excel, de la siguiente forma:
Lo importante es que los encabezados pongas una referencia que es la que vamos a buscar en word, yo puse [reemp_nombre] [reemp_telefono] [reemp_estado].
2. Ahora crea tu documento word, de la siguiente forma:
En tu documento, ahora vas a poner los encabezados de excel, en el lugar que desees.
3. Ya que tienes tu documento word terminado, guárdalo pero como plantilla de word y guárdala en la misma carpeta donde tienes tu archivo de excel.
En este ejemplo yo guardé mi archivo con el nombre de "plantilla1"
4. En tu archivo de excel pon la siguiente macro, en esta línea de la macro debes poner el nombre de tu plantilla word, recuerda que en mi ejemplo guardé la plantilla como "plantilla1":
patharch = ThisWorkbook.Path & "\plantilla1.dotx"
Sub CorrespondenciaConWord()
'Por.Dante Amor
'
patharch = ThisWorkbook.Path & "\plantilla1.dotx"
'
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.documents.Add Template:=patharch, NewTemplate:=False, DocumentType:=0
'
For j = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
textobuscar = Cells(1, j)
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=textobuscar
'
While objWord.Selection.Find.found = True
objWord.Selection.Text = Cells(i, j) 'texto a reemplazar
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=textobuscar
Wend
'
Next
'
ObjWord. Activate
ObjWord. ActiveDocument.SaveAs Cells(i, "A").Value
ObjWord. ActiveDocument. Close
ObjWord. Quit
Next
End SubSal u dos
¡Gracias! ¿y si el usuario tiene varios teléfonos y varios estados también los pone en el Word?
Sí, solamente pon el campo [reemp_telefono1], [reemp_telefono2], [reemp_telefono3], etc
sal u dos
Perdona Dante por todo el lio, ya he resuelto lo de la tabla dinámica y lo del buscar v. en cuanto a este tema que lo cerré, me ocurre esto;
Da igual que tenga varias hojas en un mismo libro Excel ¿no?
saludos
¿Y qué versión de excel tienes?
¿Es excel de windows o de mac?
¿Y por qué tienes guardado el archivo como xlsb?
¿Alguna otra cosa diferente que no me hayas contado?
-tengo office 2007
-excel de windows
-la macro la suelo guardar en el libro de macros personal y guardándolo en la mismo libro,ocurre esto;
mejor te envío un correo con el formato del informe y una captura de los datos reales, así no mareamos más la perdiz
Saludos ;) y gracias
Macro actualizada
Sub Generar_Informes()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h1 = Sheets("TABLA DINAMICA")
Set h2 = Sheets("Plantilla")
Set h3 = Sheets("Informe")
h3.Cells.Clear
i = 5
usu = h1.Cells(i, "A")
ant = usu
h2.Cells.Copy h3.[A1]
h3.Range("A2") = h3.Range("A2") & " " & usu
Do While h1.Cells(i, "D") <> ""
If h1.Cells(i, "A") <> "" Then
usu = h1.Cells(i, "A")
End If
If ant <> usu Then
'guarda hoja
H3. Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "Informe UL" & ant
ActiveWorkbook. Close
'nuevo informe
H3. Cells. Clear
h2.Cells.Copy h3.[A1]
h3.Range("A2") = h3.Range("A2") & " " & usu
End If
h3.Rows(8).Insert
h3.Cells(8, "A") = h1.Cells(i, "D")
If h1.Cells(i, "C") <> "" Then
fec = h1.Cells(i, "C")
End If
h3.Cells(8, "B") = fec
'
If h1.Cells(i, "A") <> "" Then
ant = h1.Cells(i, "A")
End If
i = i + 1
Loop
MsgBox "Proceso terminado"
End Subsal u dos
