KEMBAR78
Excel VBA Split Workbook Script | PDF
Scribd
Upload
234 views1 page

Excel VBA Split Workbook Script

This VBA code splits a worksheet into multiple files by copying rows of data in batches. It copies the header row to each new file, then copies ranges of 10 rows at a time into new workbooks. Each new workbook is saved as "parte #". The code uses variables to track the number of columns, rows per file, header range, and workbook counter.

Uploaded by

Mauricio Calderon
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
234 views1 page

Excel VBA Split Workbook Script

This VBA code splits a worksheet into multiple files by copying rows of data in batches. It copies the header row to each new file, then copies ranges of 10 rows at a time into new workbooks. Each new workbook is saved as "parte #". The code uses variables to track the number of columns, rows per file, header range, and workbook counter.

Uploaded by

Mauricio Calderon
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 1

Sub Test()

'declarar variables
Dim wb As Workbook
Dim ThisSheet As Worksheet
Dim NumOfColumns As Integer
Dim RangeToCopy As Range
Dim RangeOfHeader As Range
Dim WorkbookCounter As Integer
Dim RowsInFile

'inicializar variables
Application.ScreenUpdating = False
Set ThisSheet = ThisWorkbook.ActiveSheet
NumOfColumns = ThisSheet.UsedRange.Columns.Count
WorkbookCounter = 1

'cantidad de filas por archivo


RowsInFile = 10

'copiar las cabeceras para mantenerlas en cada archivo


Set RangeOfHeader = ThisSheet.Range(ThisSheet.Cells(1, 1), ThisSheet.Cells(1,
NumOfColumns))

'partir la informacion en multiples archivos


For p = 2 To ThisSheet.UsedRange.Rows.Count Step RowsInFile - 1

Set wb = Workbooks.Add
RangeOfHeader.Copy wb.Sheets(1).Range("A1")
Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p
+ RowsInFile - 2, NumOfColumns))
RangeToCopy.Copy wb.Sheets(1).Range("A2")

'Guardar el nuevo archivo


wb.SaveAs ThisWorkbook.Path & "\parte " & WorkbookCounter
wb.Close

'Incrementar el contador
WorkbookCounter = WorkbookCounter + 1
Next p

Application.ScreenUpdating = True
Set wb = Nothing
End Sub

You might also like