Consulting

Results 1 to 3 of 3

Thread: Vba : copy Transpose in 2 differents rows

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1

    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 :

    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 :

    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.
    Last edited by Bob Phillips; 06-16-2021 at 02:35 PM. Reason: Added code tags

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •