Copy every second value of a row and paste into a column in another sheet-CodePudding

pls help, I need a excel vba code, which copies every second value of a row

and paste that into a column in another sheet

I tried it like this

Sub Test()

Worksheets("Sheet1").Activate

Dim x As Integer

For x = 5 To 196 Step 2

Worksheets("Tabelle1").Activate

Cells(x, 2).Value = Sheets("Sheets1").Range("E2:GN2")

Next x

End Sub

CodePudding user response：

you can start from something like this:

Option Explicit

Private Sub dataCp()

Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = wb.Sheets("Tabelle1")
Dim lrow As Long, lcol As Long, i As Long

Dim rng As Range, c As Range

lcol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column


For i = 5 To lcol
    lrow = (ws2.Cells(ws2.Rows.Count, "D").End(xlUp).Row)   1
    ws2.Range("D" & lrow).Value = ws.Cells(2, i).Value
    i = i   1
Next


End Sub

CodePudding user response：

Sub test()
Dim WkSource As Worksheet
Dim WkDestiny As Worksheet
Dim i As Long
Dim j As Long
Dim LR As Long
Dim k As Long

Set WkSource = ThisWorkbook.Worksheets("Hoja1")
Set WkDestiny = ThisWorkbook.Worksheets("Hoja2")

With WkSource
    LR = .Range("E" & .Rows.Count).End(xlUp).Row
    k = 2 'starting row where you want to paste data in destiny sheet
    For i = 2 To LR Step 1
    
        For j = 5 To 12 Step 2 'j=5 to 12 because my data goes from column E to L (5 to 12)
            WkDestiny.Range("D" & k).Value = .Cells(i, j).Value
            k = k   1
        Next j
    Next i
End With

Set WkSource = Nothing
Set WkDestiny = Nothing

End Sub

The code loop trough each row and each column (notice step 2 to skip columns)

Output I get: