不知道这是不是你想要的。

Sub getemail()
    
    Dim i As Integer
    Dim Ws_Pic1 As Object, Ws_Pic2 As Object
    
    'Ws_Pic1 --> original data
    'Ws_Pic2 --> result
    
    Set Ws_Pic1 = ThisWorkbook.Sheets("Sheet1")
    Set Ws_Pic2 = ThisWorkbook.Sheets("Sheet1 (2)")

    For i = 1 To Ws_Pic1.Range("B" & Rows.Count).End(xlUp).Row
        If Ws_Pic1.Range("B" & i).Value2 <> "" Then
            If Ws_Pic2.Range("F1").Value2 = "" Then
                    Ws_Pic2.Range("A1").Value2 = Ws_Pic1.Range("B" & i).Offset(0, -1).End(xlUp).Value2
                    Ws_Pic2.Range("F1").Value2 = Ws_Pic1.Range("B" & i).Value2
                    Ws_Pic2.Range("F1").Offset(0, 1).Value2 = Ws_Pic1.Range("B" & i).Offset(0, 1).Value2
                    Ws_Pic2.Range("F1").Offset(0, 2).Value2 = Ws_Pic1.Range("B" & i).Offset(0, 2).Value2
                    Ws_Pic2.Range("F1").Offset(0, 3).Value2 = Ws_Pic1.Range("B" & i).Offset(0, 3).Value2
                Else
                    Ws_Pic2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value2 = Ws_Pic1.Range("B" & i).Offset(0, -1).End(xlUp).Value2
                    Ws_Pic2.Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value2 = Ws_Pic1.Range("B" & i).Value2
                    Ws_Pic2.Range("F" & Rows.Count).End(xlUp).Offset(0, 1).Value2 = Ws_Pic1.Range("B" & i).Offset(0, 1).Value2
                    Ws_Pic2.Range("F" & Rows.Count).End(xlUp).Offset(0, 2).Value2 = Ws_Pic1.Range("B" & i).Offset(0, 2).Value2
                    Ws_Pic2.Range("F" & Rows.Count).End(xlUp).Offset(0, 3).Value2 = Ws_Pic1.Range("B" & i).Offset(0, 3).Value2
            End If
        End If
    Next i
       
End Sub