0

I am a VBA beginner.

I want to copy cells from Sheet 1 into Sheet 2 in a certain sequential (in my case, after every 13 rows) with the condition of this: if any of the D2 to D32 in Sheet 1 is 0, copy A2 to A32 respectively. Then paste it in a sequential of +13 starting from B23 in Sheet 2.

For example:

if D2 is 0, copy A2 and paste it into B23 in Sheet 2.
if D3 is 0, copy A3 and paste it into B36 in Sheet 2.
If D4 is not 0, skip to next.
If D5 is 0, copy A5 and pate it into B49 in Sheet 2.

I feel that it is workable in VBA but I can't seem to figure it out.

I have searched the web but no answer came close to my requirement.

Sub Test()

Sheets("Sheet1").Select

For i = 2 To 32
If Sheets("Sheet1").Cells(i, 4) = 0 Then
Cells(i, 1).Copy
Else
End If

Sheets("Sheet2").Select
For j = 23 To 361 Step 13
Sheets("Sheet2").Cells(j, 2).PasteSpecial Paste:=xlPasteValues

Next j

Next i

End Sub

My current VBA keeps looping in Sheet2 until the end when the condition in Sheet1 is met. That's not what I want.

halfer
  • 19,824
  • 17
  • 99
  • 186
Gan Cy
  • 25
  • 4

3 Answers3

1

For flexibility in ranges, some speed using array and avoiding .Select and .PasteSpecial, you could try the following:

Sub Test()

Dim lr As Long, x As Long, z As Long, arr As Variant

With Sheets("Sheet1") 'Change accordingly
    lr = .Cells(.Rows.Count, "A").End(xlUp).Row
    arr = .Range("A2:D" & lr).Value
End With

For x = LBound(arr) To UBound(arr)
    If arr(x, 4) = 0 Then
        Sheets("Sheet2").Cells(23 + z * 13, 2) = arr(x, 1)
        z = z + 1
    End If
Next x

End Sub

If you always just interested in A2:A32 then this will do:

Sub Test()

Dim x As Long, z As Long, arr As Variant

arr = Sheets("Sheet1").Range("A2:D32").Value
For x = LBound(arr) To UBound(arr)
    If arr(x, 4) = 0 Then
        Sheets("Sheet2").Cells(23 + z * 13, 2) = arr(x, 1)
        z = z + 1
    End If
Next x

End Sub

You'll benefit from reading this too.

JvdV
  • 70,606
  • 8
  • 39
  • 70
  • Thanks, JvdV! Indeed it works much better compared to .Select & .PasteSpecial in term of speed! But I haven't encounter LBound & UBound before. Will definitely do some research on it. Thanks again. – Gan Cy Sep 08 '19 at 13:57
0

Please try this

Sub Test()
Dim i As Integer, n As Integer
Sheets("Sheet1").Select
n = 0
For i = 2 To 32
    Sheets("Sheet1").Activate
    If Sheets("Sheet1").Cells(i, 4) = 0 Then
        Cells(i, 1).Copy
        Sheets("Sheet2").Activate
        Sheets("Sheet2").Cells(23 + (n * 13), 2).PasteSpecial Paste:=xlPasteValues
        n = n + 1
    Else
    End If

    'Sheets("Sheet2").Select


'    For j = 23 To 361 Step 13
'        Sheets("Sheet2").Cells(j, 2).PasteSpecial Paste:=xlPasteValues
'    Next j

Next i

End Sub
Navkanth
  • 50
  • 6
0

Try this one:

Sub Test()
Dim i,j as integer
j= 1

Sheets("Sheet1").Activate
For i = 2 To 32
    If Sheets("Sheet1").Cells(i, 4) = 0 Then
        Sheets("Sheet2").Cells(10 + 13 * j, 2).Value2 = Cells(i, 1).Value2
        j = j + 1
    End If
Next

End Sub

Hope it helps

David García Bodego
  • 1,058
  • 3
  • 13
  • 21
  • 1
    Some positive criticism if you allow me :). The way you dimmed your variables makes `i` a `Variant` variable, that will turn into a `Variant/Integer`, while `j` is an integer variable. You should avoid `Integer` as there really is [no use](https://stackoverflow.com/questions/26409117/why-use-integer-instead-of-long) in using them. Use `Long` instead. Avoid the use of `.Activate` [too](https://stackoverflow.com/questions/26409117/why-use-integer-instead-of-long). – JvdV Sep 08 '19 at 08:27
  • Constructive critics are welcome. Sure that I will not do it on my own code (he said that he is a VBA beginner), so I think that it will be hard to introduce Ubound, Lbound, .End(xlUp).Row for a single loop. But you are right, your code , technically is much better. Regarding i,j definition, maybe old school things (I like to declare to make things clear) and not to use Long, where it is not needed. – David García Bodego Sep 08 '19 at 09:34
  • Thanks mate! Yes i haven't encountered the Ubound, Lbound yet. Will definitely have to look. Cheers. – Gan Cy Sep 08 '19 at 14:00