Imprimir página | Cerrar ventana

exportar/importar hojas automaticamente

Impreso de: Foro de Access y VBA
Categoría: Otros de Microsoft: Windows y Office
Nombre del foro: Excel
Descripción del foro: Foro de Excel y VBA de Excel
URL: http://www.mvp-access.com/foro/forum_posts.asp?TID=87094
Fecha de impresión: 26/Marzo/2026 a las 15:04


Tema: exportar/importar hojas automaticamente
Publicado por: acilu55
Asunto: exportar/importar hojas automaticamente
Fecha de publicación: 03/Septiembre/2025 a las 21:51
Buenas: alguien puede audarme a decirme como puedo importar/exportar todas las hojas de un libro a libros independientes?

-------------
Gracias a todos de antemano


Respuestas:
Publicado por: acilu55
Fecha de publicación: 03/Septiembre/2025 a las 22:26
exportar a lo tengo:
Sub SplitWorkbook()
'Updateby20200806
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim xWs As Worksheet
Dim xWb As Workbook
Dim xNWb As Workbook
Dim FolderName As String
Application.ScreenUpdating = False
Set xWb = Application.ThisWorkbook

DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
FolderName = xWb.Path & "\" & xWb.Name & " " & DateString

If Val(Application.Version) < 12 Then
    FileExtStr = ".xls": FileFormatNum = -4143
Else
    Select Case xWb.FileFormat
        Case 51:
            FileExtStr = ".xlsx": FileFormatNum = 51
        Case 52:
            If Application.ActiveWorkbook.HasVBProject Then
                FileExtStr = ".xlsm": FileFormatNum = 52
            Else
                FileExtStr = ".xlsx": FileFormatNum = 51
            End If
        Case 56:
            FileExtStr = ".xls": FileFormatNum = 56
        Case Else:
            FileExtStr = ".xlsb": FileFormatNum = 50
        End Select
End If

MkDir FolderName

For Each xWs In xWb.Worksheets
On Error GoTo NErro
    If xWs.Visible = xlSheetVisible Then
    xWs.Select
    xWs.Copy
    xFile = FolderName & "\" & xWs.Name & FileExtStr
    Set xNWb = Application.Workbooks.Item(Application.Workbooks.Count)
    xNWb.SaveAs xFile, FileFormat:=FileFormatNum
    xNWb.Close False, xFile
    End If
NErro:
    xWb.Activate
Next

    MsgBox "You can find the files in " & FolderName
    Application.ScreenUpdating = True
End Sub

funciona de cine



-------------
Gracias a todos de antemano

Publicado por: acilu55
Fecha de publicación: 18/Septiembre/2025 a las 12:52
copiar  una hoja  a otra de distinto libro resuelto tambien

Sub importarDatos()

    ' Declarar variables
    Dim origenWs As Worksheet
    Dim destinoWs As Worksheet
    Dim rangoACopiar As Range
    Dim libroDestino As Workbook ' referencio los libros origen y destino
    Dim libroorigen As Workbook
    
    
   Dim coas As Integer
coas = Range("A5").Value
Dim colegio As String
 
For n = 22 To 22 + coas - 1 ' situación de los nombre de las hojas/libros a importar
'Range("a" & n).Visible = True
Range("a" & n).Activate
colegio = Range("a" & n).Value
   
    
    ' --- Configura la hoja copiar ---
  Set libroorigen = Workbooks.Open("C:\Users\Usuario\Desktop\cscae\hojas por colegio\" & colegio & ".xlsm")
Set libroDestino = Workbooks.Open("C:\Users\Usuario\Desktop\cscae\hojas por colegio\100.xlsm")
   
libroorigen.Sheets(1).Copy after:=libroDestino.Worksheets(Sheets.Count) ' el libro de origen solo tiene una hoja y la cipia al final de libro de destino
libroorigen.Close
libroDestino.Close savechanges:=True
Next

End Sub

podeis cerrar el hilo que ya esta resuelto




-------------
Gracias a todos de antemano


Imprimir página | Cerrar ventana