[英]Copy to New Worksheet when row is blank
問題
我需要一個宏,當我遇到空白行時可以將其從sheet1復制到sheet [i]。
樣本數據
asdfasdf 1234
asdf 1234
gasdf 1234
asdf 1234
asdf 1234
fdas 1234
ds 1234
1234d 1234
結果
該宏應該已經獲取了該示例數據並創建了4個新工作表。 每個分組都是自己的電子表格。
碼
我對VBA有點陌生,所以我並不總是了解代碼,但是我確實找到了這種代碼。 我無法完全理解它以使其正常工作。
Sub CreateNewWorksheets()
Dim lLoop As Long, lLoopStop As Long
Dim rMove As Range, wsNew As Worksheet
Set rMove = ActiveSheet.UsedRange.Columns(1)
lLoopStop = WorksheetFunction.CountIf(rMove, "Category")
For lLoop = 1 To lLoopStop
Set wsNew = Sheets.Add
rMove.Find("Category", rMove.Cells(1, 1), xlValues, _
xlPart, , xlNext, False).CurrentRegion.Cut _
Destination:=wsNew.Cells(1, 1)
wsNew.UsedRange.Columns.AutoFit
Next lLoop
End Sub
還有另一個解決方案
'Split File up by blank sections
Application.ScreenUpdating = False
For Each c In ActiveSheet.Range("A:C").SpecialCells(xlCellTypeConstants).Areas
c.Copy Destination:=Worksheets.Add(After:=Sheets(Sheets.Count)).Range("A1")
Next c
兩者都不適合我。
提前致謝
試試看:
Sub CreateNewWorksheets()
Dim rngStart As Range
Dim rngEnd As Range
Set rngStart = Range("A1")
If Len(rngStart.Text) = 0 Then Set rngStart = rngStart.End(xlDown)
Do
Select Case (Len(rngStart.Offset(1).Text) = 0)
Case True: Set rngEnd = rngStart
Case Else: Set rngEnd = rngStart.End(xlDown)
End Select
Range(rngStart, rngEnd).EntireRow.Copy Sheets.Add(After:=Sheets(Sheets.Count)).Range("A1")
Set rngStart = rngEnd.End(xlDown)
Loop While rngStart.Row < Rows.Count
Set rngStart = Nothing
Set rngEnd = Nothing
End Sub
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.