/ / Copiando la hoja de datos base junto con las hojas seleccionadas del libro de trabajo de origen al nuevo libro de trabajo - excel, vba

Copiando la hoja de datos base junto con las hojas seleccionadas del libro de trabajo de origen al nuevo libro de trabajo - excel, vba

Estoy buscando construir un libro maestro querecibe un volcado mensual de datos para todos los Centros de Costos que luego completarán una gran cantidad de hojas de trabajo dentro del libro de trabajo, y que luego deben dividirse y enviarse a los jefes de servicio. Un jefe de servicio recibirá una selección de hojas de trabajo basadas en los primeros 4 caracteres del nombre de la hoja (aunque esto puede cambiar a su debido tiempo).

por ejemplo, 1234x, 1234y, 5678a, 5678b producirán dos nuevos libros de trabajo llamados 1234 y 5678 con dos hojas en cada uno.

He improvisado un código de varios foros paracree una macro que funcione a través de una matriz codificada que defina los códigos de 4 caracteres del jefe de servicio y cree una serie de libros nuevos. Y lo que parece funcionar.

Sin embargo.. También necesito incluir la hoja de volcado de datos principal dentro del archivo fuente (llamada "datos") con la matriz de archivos que se copian para que los enlaces permanezcan con la hoja de datos que se copia. Si escribo una línea para copiar sobre la hoja de datos por separado, el nuevo libro de trabajo todavía hace referencia al archivo fuente, al que los jefes de servicio no tienen acceso.

Entonces, la pregunta principal es: ¿cómo puedo agregar la pestaña "datos" en las Hojas (CopyNames). Copie el código para que se copie con todos los demás archivos de la matriz al mismo tiempo para mantener los enlaces intactos?

La segunda pregunta es si decido que es la primerados caracteres de la hoja de trabajo definen las hojas que se relacionan con un jefe de servicio, ¿cómo modifico la línea de código dividida / media? ¡He probado pero estoy atado!

Cualquier otro consejo para que el código sea mucho más eleganteapreciado (puede haber una lista bastante larga de códigos principales de servicio y estoy seguro de que hay una mejor manera de crear una lista para que la rutina se repita)

    Sub Copy_Sheets()
Dim strNames As String, strWSName As String
Dim arrNames, CopyNames
Dim wbAct As Workbook
Dim i As Long
Dim arrlist As Object

Set arrlist = CreateObject("system.collections.arraylist")
arrlist.Add "1234"
arrlist.Add "5678"


Set wbAct = ActiveWorkbook
For Each Item In arrlist

For i = 1 To Sheets.Count
strNames = strNames & "," & Sheets(i).Name
Next i
arrNames = Split(Mid(strNames, 2), ",")

"strWSName =("1234")
strWSName = Item

Application.ScreenUpdating = False
CopyNames = Filter(arrNames, strWSName, True, vbTextCompare)
If UBound(CopyNames) > -1 Then
Sheets(CopyNames).Copy
ActiveWorkbook.SaveAs Filename:=strWSName & " " & Format(Now, "dd-mmm-yy h-mm-ss")
ActiveWorkbook.Close
wbAct.Activate
Else
MsgBox "No sheets found: " & strWSName
End If

Next Item

Application.ScreenUpdating = True

End Sub

Respuestas

0 para la respuesta № 1
Option Explicit

Sub CopySheets()

With ThisWorkbook

Dim SheetIndex As Long
Dim ValidSheetNames() As String
ReDim ValidSheetNames(1 To .Worksheets.Count)

" Build a 1 dimensional array called ValidSheetNames, which contains every sheet in the master workbook other than DEDICATEDSHEET. "
Dim ws As Worksheet
For Each ws In .Worksheets
If ws.Name <> "DEDICATEDSHEET" Then
SheetIndex = SheetIndex + 1
ValidSheetNames(SheetIndex) = ws.Name
End If
Next ws
ReDim Preserve ValidSheetNames(1 To SheetIndex)

" Read all ServiceCodes into a 1-dimensional array "
Dim ServiceHeadCodes As Variant
ServiceHeadCodes = Application.Transpose(.Worksheets("DEDICATEDSHEET").Range("CCLIST[CC]").Value2)

Dim CodeIndex As Long

" Now loop through each ServiceHeadCode "
For CodeIndex = LBound(ServiceHeadCodes) To UBound(ServiceHeadCodes)

" Put all sheet names which contain the current ServiceHeadCode into an array called SheetsToCopy "
Dim SheetsToCopy() As String
SheetsToCopy = Filter(ValidSheetNames, ServiceHeadCodes(CodeIndex), True, vbTextCompare)

" Check if SheetToCopy now contains any sheet names at all. "
If UBound(SheetsToCopy) > -1 Then

" Add the name of the Data sheet to the end of the array "
ReDim Preserve SheetsToCopy(LBound(SheetsToCopy) To (UBound(SheetsToCopy) + 1))
SheetsToCopy(UBound(SheetsToCopy)) = "Data"


Dim OutputWorkbook As Workbook
Set OutputWorkbook = Application.Workbooks.Add

" Copy all sheets which are in SheetToCopy array to newly created OutputWorkbook "
.Worksheets(SheetsToCopy).Copy OutputWorkbook.Worksheets(1)

" Delete the default Sheet1, which should be at the end as copied sheets were inserted before it. "
" But suppress the Are you sure you want to delete this sheet.. message. "
Application.DisplayAlerts = False
OutputWorkbook.Worksheets(OutputWorkbook.Worksheets.Count).Delete
Application.DisplayAlerts = True
" Re-enable alerts, as we want to see any other dialogue boxes/messages

" Not providing a full directory path below means OutputWorkbook will be saved wherever Thisworkbook is saved."
OutputWorkbook.SaveAs Filename:=ServiceHeadCodes(CodeIndex) & " " & Format(Now, "dd-mmm-yy h-mm-ss") & ".xlsx", FileFormat:=51
OutputWorkbook.Close
Else
MsgBox "No sheets found: " & ServiceHeadCodes(CodeIndex)
End If

Next CodeIndex

End With

End Sub

No probado y escrito en el móvil, perdón por el mal formato.

Este enfoque propone que almacene todo el serviciocódigos de encabezado en una tabla de Excel de 1 columna en una hoja dedicada a la que se hace referencia mediante la nomenclatura de la tabla de Excel (que podría ser más fácil que ArrayList. Agregue para cada nuevo código de encabezado de servicio)

Supongo que el código se almacena en el libro de trabajo maestro ("este libro de trabajo"), lo que podría no ser cierto.

Puede modificar la tabla serviceheadcodesdirectamente en la hoja de cálculo, si luego decide que SheetsToCopy estará determinado por los primeros 2, 3 o X caracteres, o puede modificar la matriz con la función izquierda $ ().

Espero que funcione o te dé algunas ideas.

Editar: Este es mi diseño de hoja y tabla (que supongo que coincide con el tuyo).

Estructura de hoja y mesa

Y esto es lo que el código anterior me da en mi computadora.

Archivos de salida