copy specific columns to other worksheet with vba

[bflatcoat]

I have data on sheet1: one row per item. I would like to copy and transpose certain columns but not all to sheet2.
lines with "not" in the B column need to be skipped. see the example.

hope you can help!

what I have

What I need

 

[Osvaldo Palmeiro]

Try:

Sub ReplicateData()
 Dim k As Long, r As Range, rng As Range
  Application.ScreenUpdating = False
  Sheets("Sheet2").Cells = ""
  With Sheets("Sheet1")
   On Error Resume Next
   .AutoFilter.ShowAllData
   On Error GoTo 0
   .Range("A1:D1").AutoFilter 2, "<>" & "not"
   Set rng = .Range("A1:A" & .Cells(Rows.Count, 1).End(3).Row).SpecialCells(12)
   .Columns(3).Hidden = True
   For Each r In rng
    .Range(r, r.Offset(, 3)).SpecialCells(12).Copy
    Sheets("Sheet2").Cells(Rows.Count, k + 1).End(3)(2).PasteSpecial Transpose:=True: k = k + 1
   Next r
   .Columns(3).Hidden = False
   .AutoFilter.ShowAllData
  End With
End Sub

 

[JoeMo]

Another way:

Sub TransposeIfNot()
Application.ScreenUpdating = False
With Sheets("Sheet1").Range("A1").CurrentRegion
    For i = 1 To .Rows.Count
        .Rows(i).Copy
        Sheets("Sheet2").Columns(i).Cells(1, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
    Next i
    Application.CutCopyMode = False
    With Sheets("Sheet2").Range("A1").CurrentRegion
        On Error Resume Next
        .Columns(1).Replace "city", "#N/A"
        .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
        .Rows(2).Replace "not", "#N/A"
        .SpecialCells(xlCellTypeConstants, xlErrors).EntireColumn.Delete
    End With
End With
Application.ScreenUpdating = tru
        
End Sub

 

[bflatcoat]

Thank you! both options worked. second was a bit nicer since it doesn't change sheet 1 to include autofilter and after running it the cells in the laat row are still selected.