CODEWITHSUNDEEP
excelvba
k1dr0ck
k1dr0ck

Reputation: 1215

loop thru offset data copy to new sheet

from the first pic how do you loop thru the offset data then copy to another sheet result is second pic

enter image description here

enter image description here

Upvotes: 0

Views: 47

Answers (1)

DavidLim
DavidLim

Reputation: 63

Not sure if this is what you wanted.

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

Upvotes: 1

Related Questions