拆分sheet

每個sheet存到一個新文件中

Sub chaifen()Dim sht As WorksheetDim MyBook As WorkbookSet MyBook = ActiveWorkbookFor Each sht In MyBook.Sheetssht.CopyActiveWorkbook.SaveAs Filename:=MyBook.Path & "\" & MyBook.Name & "_" & sht.Name & ".xls"ActiveWorkbook.CloseNextMsgBox "文件已經被分拆完畢!" End Sub

拆分行

文件行數太多，按照每20行進行切割，切割后存到新的excel表中。

Sub splitRow() Application.ScreenUpdating = False p = ActiveWorkbook.Path & "\" With ActiveSheetFor r = 1 To .Range("a1048576").End(xlUp).Row Step 20Set wb = Workbooks.Add.Rows(r).Resize(30).Copy wb.Sheets(1).Cells(1)wb.SaveAs p & r & ".xls", xlNormalwb.CloseNext End With Application.ScreenUpdating = True End Sub

根據單元格創建sheet

循環目標區域，如果對應名字的sheet已經有了，就不創建，否則創建對應的sheet

Sub process() Dim sht As Worksheet Dim i, k As Integer For Each rag In Range("d2:d1000")k = 0For Each sht In SheetsIf rag.Value = sht.Name Thenk = 1Exit ForEnd IfNextIf k = 0 ThenSheets.Add after:=Sheets(Sheets.Count)Sheets(Sheets.Count).Name = ragEnd If Next End Sub

目標區域復制到其他sheet

Sub copytosheet() For i = 2 To Sheets.CountSheets(1).Range("a1").Copy Sheets(i).Range("a1") Next End Sub

對整個文件夾內的所有文件處理

下面的案例，掃描目標文件夾內所有的xlsx文件，然后執行processEach過程。
processEach過程會打開這個文件，對文件執行mysplit，然后保存關閉。
mysplit過程會把文件拆開，放到文件所在位置的子文件夾內。

整個代碼的作用：
把strPath下的所有xlsx文件切割，切割的規則是每30行切一次。切割出來的文件放在全部strPath/target下。

Sub ListFiles()Dim strPath As String, strTmp As StringDim originbook As WorkbookstrPath = "C:\test\"strTmp = Dir(strPath & "*.xlsx")i = 1Do While strTmp <> ""Call processEach(strPath, strTmp) strTmp = Diri = i + 1Loop End SubSub processEach(filepath As String, filename As String) Workbooks.Open filepath & filename With ActiveSheetCall mysplit(30) End With Workbooks(filename).Save Workbooks(filename).Close End SubSub mysplit(m As Integer) Application.ScreenUpdating = False p = ActiveWorkbook.Path & "\target\" On Error Resume Next VBA.MkDir p fn = ActiveWorkbook.Name With ActiveSheetFor r = 1 To .Range("a1048576").End(xlUp).Row Step mSet wb = Workbooks.Add.Rows(r).Resize(m).Copy wb.Sheets(1).Cells(1)wb.SaveAs p & fn & "_" & r & ".xlsx"wb.CloseNext End With Application.ScreenUpdating = True End Sub

總結

以上是生活随笔為你收集整理的实用vba案例的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。