excel vba - una - Guardar como error al guardar copia del original

macro para guardar varias hojas de excel en pdf

Question

Me pregunto si alguien podría ayudarme, por favor.

Usando una secuencia de comandos que encontré en línea como una ''base'' he escrito la consulta a continuación.

Sub Test()
  Dim wb As Workbook
  Dim ThisSheet As Worksheet
  Dim NumOfColumns As Integer
  Dim RangeToCopy As Range
  Dim RangeOfHeader As Range    ''data (range) of header row
  Dim WorkbookCounter As Integer
  Dim RowsInFile           ''how many rows (incl. header) in new files?
  Dim fNameAndPath As Variant


  fNameAndPath = Application.GetOpenFilename(Title:="Select File To Be Opened")
  If fNameAndPath = False Then Exit Sub
  Workbooks.Open Filename:=fNameAndPath


  Application.ScreenUpdating = False

  ''Initialize data
  Set ThisSheet = ActiveWorkbook.Worksheets(1)
  NumOfColumns = ThisSheet.UsedRange.Columns.Count
  WorkbookCounter = 1
  RowsInFile = 50    ''as your example, just 1000 rows per file

  ''Copy the data of the first row (header)
  Set RangeOfHeader = ThisSheet.Range(ThisSheet.Cells(1, 1), ThisSheet.Cells(1, NumOfColumns))


  For p = 2 To ThisSheet.UsedRange.Rows.Count Step RowsInFile - 1
    Set wb = Workbooks.Add

  ''Paste the header row in new file
    RangeOfHeader.Copy wb.Sheets(1).Range("A1")

  ''Paste the chunk of rows for this file
    Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p + RowsInFile - 2, NumOfColumns))
    RangeToCopy.Copy wb.Sheets(1).Range("A2")

  ''Save the new workbook, and close it

  Application.ScreenUpdating = False

  With wb
    .SaveAs Filename:=fNameAndPath & "/File " & WorkbookCounter, FileFormat:=xlCSV
    wb.Close False
    Application.DisplayAlerts = True
 End With

  ''Increment file counter
    WorkbookCounter = WorkbookCounter + 1
  Next p

  Application.ScreenUpdating = True
  Set wb = Nothing
End Sub

El propósito de la secuencia de comandos toma un archivo "maestro" y se divide en archivos más pequeños, guardándolos como un archivo CSV.

With wb
    .SaveAs Filename:=fNameAndPath & "/File " & WorkbookCounter, FileFormat:=xlCSV
    wb.Close False
    Application.DisplayAlerts = True
 End With

Lo que intento hacer es crear guardar los archivos recién creados utilizando el nombre del archivo original como parte del nombre del archivo recién creado y luego cerrar todos los archivos.

¿Podrían algunos quizás ofrecer alguna orientación sobre dónde me he equivocado?

Muchas gracias y un cordial saludo

Chris

Answer 1

Declare una variable de objeto más libro de trabajo como

Dim wb1 As Workbook

cuando abre el archivo asigna archivo a la nueva variable del libro de trabajo ( wb1 ) -

Set wb1 = Workbooks.Open(Filename:=fNameAndPath)

With wb
 .SaveAs Filename:=wb1.Path & "/" & Left(wb1.Name, InStr(wb1.Name, ".") - 1) & "_File " & WorkbookCounter, FileFormat:=xlCSV
  wb.Close False
  Application.DisplayAlerts = True
End With

La cadena fNameAndPath no funcionará ya que tiene una dirección de carpeta con nombre de archivo

Answer 2

No puedo comentar todavía, pero esta es una continuación de los comentarios de la publicación de ASH.

Parece que solo necesita dejar el .csv en el medio de su nuevo nombre de archivo. Puedes hacer esto usando

fNameAndPath = Left(ThisWorkbook.FullName, (InStrRev(ThisWorkbook.FullName, ".", -1, vbTextCompare) - 1))

Esto soltará la extensión del archivo (CSV o de otro modo). Haz esto antes de tu línea de saveas.

Answer 3

.SaveAs Filename:=fNameAndPath & "/File " & WorkbookCounter, FileFormat:=xlCSV
''                                ^^^

Parece un nombre no válido, ya que fNameAndPath ya es la ruta y el nombre de un archivo de Excel, algo así como C:/Folder/something.csv , por lo que no puede ser una carpeta. ¿Estás tratando de tener un / en el nombre del archivo guardado?

Si lo que desea es crear diferentes archivos en la misma carpeta del archivo csv que acaba de abrir, puede usar _ (guión bajo, o cualquier otro carácter aceptable por el sistema operativo en los nombres de archivo). para que puedas intentarlo en su lugar:

.SaveAs Filename:=fNameAndPath & "_File " & WorkbookCounter, FileFormat:=xlCSV
''                                ^^^

EDITAR

Después de comprender mejor sus requisitos, con respecto a la denominación de archivos y la división que desea lograr, he vuelto a factorizar su código.

Básicamente "File x.csv" la extensión del archivo antes de agregar "File x.csv" al nombre. También eliminé Copy/Paste cosas a favor de asignar valores (que deberían ir más rápido) ya que está generando un csv por lo que no quiere ningún formato, solo valores. Algunos comentarios en el código califican más el enfoque.

Sub SplitWorksheet()
  Dim rowsPerFile As Long: rowsPerFile = 50 '' <-- Set to appropriate number

  Dim fNameAndPath
  fNameAndPath = Application.GetOpenFilename(Title:="Select File To split")
  If fNameAndPath = False Then Exit Sub
  Dim wbToSplit As Workbook: Set wbToSplit = Workbooks.Open(Filename:=fNameAndPath)

  Application.ScreenUpdating = False: Application.DisplayAlerts = False
  On Error GoTo Cleanup

  Dim sheetToSplit As Worksheet: Set sheetToSplit = wbToSplit.Worksheets(1)
  Dim numOfColumns As Long: numOfColumns = sheetToSplit.UsedRange.Columns.Count
  Dim wbCounter As Long: wbCounter = 1 '' auto-increment for file names

  Dim rngHeader As Range, rngToCopy As Range, newWb As Workbook, p  As Long
  Set rngHeader = sheetToSplit.Range("A1").Resize(1, numOfColumns) '' header row

  For p = 2 To sheetToSplit.UsedRange.Rows.Count Step rowsPerFile - 1
    '' Get a chunk for each new workbook
    Set rngToCopy = sheetToSplit.Cells(p, 1).Resize(rowsPerFile - 1, numOfColumns)
    Set newWb = Workbooks.Add
    '' copy header and chunk
    newWb.Sheets(1).Range("A1").Resize(1, numOfColumns).Value = rngHeader.Value
    newWb.Sheets(1).Range("A2").Resize(rowsPerFile - 1, numOfColumns).Value = rngToCopy.Value2

    '' Save the new workbook with new name then close it
    '' Remove extension from original name then add "_File x.csv"
    Dim newFileName As String
    newFileName = Left(fNameAndPath, InStrRev(fNameAndPath, ".") - 1)
    newFileName = newFileName & "_File " & wbCounter & ".csv"

    newWb.SaveAs Filename:=newFileName, FileFormat:=xlCSV
    newWb.Close False
    wbCounter = wbCounter + 1
  Next p

Cleanup:
  If Err.Number <> 0 Then MsgBox Err.Description
  If Not wbToSplit Is Nothing Then wbToSplit.Close False
  Application.ScreenUpdating = True: Application.DisplayAlerts = True
End Sub