Vba : copy Transpose in 2 differents rows

Hi,

I am a beginner and for my first code I would to achieve a copy and transpose on 2 different rows, in function of an argument :
Exp : copy value in range A1:A8 if value in column B = "good" and paste in Range C1:F1 and Range C2:F2, avoiding blank and repetition in 2 ranges.

I started with that :

Code:

---

Sub Try()
Dim x As Integer

    For x = 1 To 4

        If Worksheets("sheet1").Range("B" & x) = "good" Then

            Worksheets("sheet1").Range("A" & x).Copy
            lastrow = Worksheets("sheet1").Range("J" & Rows.Count).End(xlUp).Row
            Worksheets("sheet1").Range("J" & lastrow + 1).PasteSpecial Paste:=xlPasteValues
        End If
    Next x

    Worksheets("sheet1").Range("J2:J5").Copy
    Worksheets("sheet1").Range("C1:F1").PasteSpecial transpose:=True
    Range("J2:J5").ClearContents

    For x = 5 To 8

        If Worksheets("sheet1").Range("B" & x) = "good" Then
       
            Worksheets("sheet1").Range("A" & x).Copy
            lastrow = Worksheets("sheet1").Range("J" & Rows.Count).End(xlUp).Row
            Worksheets("sheet1").Range("J" & lastrow + 1).PasteSpecial Paste:=xlPasteValues
        End If
    Next x

    Worksheets("sheet1").Range("J2:J5").Copy
    Worksheets("sheet1").Range("C2:F2").PasteSpecial transpose:=True
    Range("J2:J5").ClearContents
End Sub

---

but I think it's pretty slown to run and I have still blank cells.

I was thinking doing an offset after :

Code:

---

Dim cell As Range

        For Each cell In Active        Sheet.Range("C1:F1")
   
                If IsEmpty(cell) Then
                        cell.Value = cell.offset(1, -1).Value
                End If
        Next cell

---

But I end up with repetition on the same values.

I hope it's clear enough and if someone can help me. thank you.

Code:

---

Sub Maybe()
If Cells(1, 2).Value = "good" Then
    Cells(1, 3).Resize(, 4).Value = Application.Transpose(Cells(1, 1).Resize(4).Value)
    Cells(2, 3).Resize(, 4).Value = Application.Transpose(Cells(5, 1).Resize(4).Value)
End If
End Sub

---

Or so?

Code:

---

Sub Maybe_So()
Dim ii As Long, i As Long, jj As Long, j As Long
ii = 3
    For i = 1 To 4
        If Cells(i, 2).Value = "good" Then Cells(1, ii).Value = Cells(i, 1).Value: ii = ii + 1
    Next i
jj = 3
    For j = 5 To 8
        If Cells(j, 2).Value = "good" Then Cells(2, jj).Value = Cells(j, 1).Value: jj = jj + 1
    Next j
End Sub

---