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 :
but I think it's pretty slown to run and I have still blank cells.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
I was thinking doing an offset after :
But I end up with repetition on the same values.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
I hope it's clear enough and if someone can help me. thank you.