Vba excel разбить на страницы
Hi, great time saver, thanks. I know it is an old post but hopefully someone can help.
My table needs splitting based on column 1, but column 1 contains dates and the result is that each new sheet doesnt contain any data. It creates the right amount of sheets but doesnt move any data. Any Ideas?
Hello, Carrington,
To split the data based on the date column, you should use the following vba code, but, this code is only applied to date column correctly, if your key column is normal data, please use the code in this article.
Sub parseData_Date()
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
Dim xName As String
Dim xValue As String
Dim xArrFind As Variant
Dim xStrReplace As String
Dim xFNum As Integer
Dim xRg As Range
Set ws = Sheets("Master sheet")
xArrFind = Array(":", "\", "/", "?", "*", "[", "]")
xStrReplace = "_"
vcol = 1
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:C1"
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
On Error Resume Next
For i = 2 To lr
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
Set xRg = ws.Cells(i, vcol)
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
xValue = ""
xValue = myarr(i)
xValue = FormatDateTime(xValue)
xName = xValue
For xFNum = 0 To UBound(xArrFind)
xName = Replace(xName, xArrFind(xFNum), xStrReplace)
Next xFNum
ws.Range(title).AutoFilter field:=vcol, Criteria1:=xValue & ""
If Not Evaluate("=ISREF('" & xName & "'!A1)") Then
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = xName & ""
Else
Sheets(xName & "").Move After:=Worksheets(Worksheets.Count)
End If
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(xName & "").Range("A1")
Sheets(xName & "").Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate
End Sub
Please try it, hope it can help you!
Does this VBA code not work if there are other characters like -, () are in the column that we want to split? If not, how can I update the code to control for that? hi,I 've to do un upgrade in this code. More specific, i have a Dataset("Data") to split in multiple sheet and this code it's good to me. But in my new sheet i don't want all column from the orignal data but only specific column. How can i do?Hi there, is there a limit on the number of rows in the worksheet you need to split? I have 150,000 rows, that need to be split into diff worksheets based on name of company - this VBA is not working If you have tens of thousands rows data need to be split, I will recommend you to use the Kutools for Excel's Split Data feature, with this feature, you can achieve the job quickly and easily. You can download and free trail 30 days. Please try, thank you! Is there anyway to do this in a way that will maintain the page layout/print set up? header, footer, gridlines, repeat rows, lanscape, narrow margins, fit columns on page, etc? Just used this today and the VB Script was exactly what I needed. Thank you!
But is there any option to keep transferred datas to each excel sheet, if the master sheet is updating daily? Hi, question, is there a good way to ONLY bring in certain columns to the split sheets, instead of all? Dude this is brilliant. saved me many hours of work. Thank you.
Nothing happens. I run the code, it prompts me for the header & column info, I input it, and then nothing. Not even an error to point me in the right direction.
Thank you so much for this code it has helped me over the last few months amazingly.
However, since last month this code has not working for me. It only creates sheets with the name but data, format as well as headers are not carrying over.
I have changed my computer though not sure if this has to do something with it. I have been using the same code and steps as specified above.
I Have problem with borders. In each new table the bottom border is missing. How can I change to have it paste starting at cell a10 instead of a1 on the new sheets?Hi there,
Thank you so much for this post. It is really very helpful.
I have another situation that requires me to split salary data per department so that each manager will receive a workbook for their team only. I do not mail these out to managers, I simply safe it in their respective folder on the server.
I use this code, but this code does not split the worksheet into separate files. Can you please help me to modify this code so that it will create separate workbooks for me in the same directory as the master sheet?
Читайте также: