從工作表中複製數據，直到條件

Question

我有一個工作表，其中包含列B到列D中的數據。我想從B4複製數據，直到它的單元格的值爲空，並粘貼到一個單獨的並將表格更改爲值B4，然後必須複製下一個單元格值，直到單元格值與infront之間的空格，然後繼續，直到列B具有空單元格爲止。

除此之外，我必須在列A中輸入序列號方面的數據沒有空間inits初始階段。我已附上輸入和預期的輸出圖像供您參考。

輸入：

預期輸出：

請在這個問題上提供幫助。

Answer 1

假設你片如下：

在Cell A4

=IF(LEFT(B4,1)<>" ",COUNTA($A$2:A3)+1-COUNTBLANK($A$2:A3),"") 

拖動輸入以下公式/根據需要複製下來公式。

如果你正在尋找一個VBA解決方案，下面應該工作：

Sub Demo() 
    Dim ws As Worksheet 
    Dim lastRow As Long, index As Long, i As Long 
    Dim rng As Range 

    index = 1 
    Set ws = ThisWorkbook.Sheets("Sheet1") '---->change the sheet name as required 
    lastRow = ws.Cells(Rows.count, "B").End(xlUp).Row 
    Set rng = ws.Range("B4:B" & lastRow) 
    For i = 4 To lastRow 
     If Left(ws.Cells(i, 2).Value, 1) <> " " Then 
      ws.Cells(i, 1).Value = index 
      index = index + 1 
     End If 
    Next i 
End Sub 

_______________________________________________________________________________

編輯1：一是複製數據從Sheet1到Sheet2，然後添加序列號。

Sub Demo() 
    Dim ws1 As Worksheet, ws2 As Worksheet 
    Dim lastRow As Long, index As Long, i As Long 
    Dim rng As Range 

    index = 1 
    Set ws1 = ThisWorkbook.Sheets("Sheet1") '---->change the sheet name as required 
    Set ws2 = ThisWorkbook.Sheets("Sheet2") 
    lastRow = ws1.Cells(Rows.count, "B").End(xlUp).Row 
    ws1.Range("B2:D" & lastRow).Copy Destination:=ws2.Range("B2") 
    Set rng = ws2.Range("B4:B" & lastRow) 
    For i = 4 To lastRow 
     If Left(ws2.Cells(i, 2).Value, 1) <> " " Then 
      ws2.Cells(i, 1).Value = index 
      index = index + 1 
     End If 
    Next i 
End Sub 

_______________________________________________________________________________

EDIT 2：

Sub Demo() 
    Dim srcWS As Worksheet, destWS As Worksheet 
    Dim lastRow As Long, index As Long, i As Long 
    Dim copyRng As Range, rng1 As Range, rng2 As Range 

    index = 1 
    Set srcWS = ThisWorkbook.Sheets("Sheet1") '---->change the sheet name as required 
    lastRow = srcWS.Cells(Rows.count, "B").End(xlUp).Row 
    Set rng1 = srcWS.Cells(4, 2) 
    For i = 4 To lastRow 
     If Left(srcWS.Cells(i, 2).Value, 1) <> " " Then 
      srcWS.Cells(i, 1).Value = index 
      index = index + 1 
      If i <> 4 Then 
       Set rng2 = srcWS.Cells(i - 1, 4) 
       Set destWS = Sheets.Add(After:=Sheets(Sheets.count)) 
       srcWS.Range(rng1, rng2).Copy Destination:=destWS.Range("B4") 
       Set rng1 = srcWS.Cells(i, 2) 
      End If 
     End If 
    Next i 
    Set rng2 = srcWS.Cells(lastRow, 4) 

    Set destWS = Sheets.Add(After:=Sheets(Sheets.count)) 
    srcWS.Range(rng1, rng2).Copy Destination:=destWS.Range("B4") 

End Sub