简体   繁体   中英

VBA - For ... Next Loop

I'm trying to copy values from one sheet to another, if the conditions are right. I did it with 3 nested loops. Unfortunately the code only gives me the first value.

for example:

i = 7, j = 3, k = 2

(i, j) = (7,3) is an "E" in the "Januar" sheet. This E is then continuously copied and pasted.

But I want the second value (i, j) = (7,4), which is an "U" copied and pasted and so on...

I don't quite understand where the problem is in my code. I would be glad if someone can help me. I would also be happy about a better and faster solution.

Dim i As Integer, Dim j As Integer, Dim k As Integer

For i = 7 To 37
    If Worksheets("Januar").Cells(i, 2).Value = Worksheets("Drucken").Cells(12, 12).Value Then
        For j = 3 To 5
            Worksheets("Januar").Cells(i, j).Copy
                For k = 2 To 4
                    Worksheets("Drucken").Activate
                    Worksheets("Drucken").Cells(38, k).Select
                    ActiveSheet.Paste
                Next
            Worksheets("Januar").Activate
        Next
    End If
Next

EDIT:

Here is what I want

I want these values from Sheet("Januar") copied and pasted into在此处输入图像描述

this Sheet("Drucken") 在此处输入图像描述

I solved the problem like this:

Dim i As Integer
   
For i = 7 To 37
If Worksheets("Januar").Cells(i, 2).Value = Worksheets("Drucken").Cells(12, 12).Value Then
        Worksheets("Januar").Cells(i, 3).Copy Worksheets("Drucken").Cells(38, 2)
        Worksheets("Januar").Cells(i, 4).Copy Worksheets("Drucken").Cells(38, 3)
        Worksheets("Januar").Cells(i, 5).Copy Worksheets("Drucken").Cells(38, 4)
        Worksheets("Januar").Cells(i, 6).Copy Worksheets("Drucken").Cells(38, 5)
        Worksheets("Januar").Cells(i, 7).Copy Worksheets("Drucken").Cells(38, 6)
        Worksheets("Januar").Cells(i, 8).Copy Worksheets("Drucken").Cells(38, 7)
        Worksheets("Januar").Cells(i, 9).Copy Worksheets("Drucken").Cells(38, 8)
        Worksheets("Januar").Cells(i, 10).Copy Worksheets("Drucken").Cells(38, 9)
        Worksheets("Januar").Cells(i, 11).Copy Worksheets("Drucken").Cells(38, 10)
        Worksheets("Januar").Cells(i, 12).Copy Worksheets("Drucken").Cells(38, 11)
        Worksheets("Januar").Cells(i, 13).Copy Worksheets("Drucken").Cells(38, 12)
        Worksheets("Januar").Cells(i, 14).Copy Worksheets("Drucken").Cells(38, 13)
        Worksheets("Januar").Cells(i, 15).Copy Worksheets("Drucken").Cells(38, 14)
        Worksheets("Januar").Cells(i, 16).Copy Worksheets("Drucken").Cells(38, 15)
        Worksheets("Januar").Cells(i, 17).Copy Worksheets("Drucken").Cells(38, 16)
        Worksheets("Januar").Cells(i, 18).Copy Worksheets("Drucken").Cells(38, 17)
        Worksheets("Januar").Cells(i, 19).Copy Worksheets("Drucken").Cells(38, 18)
        Worksheets("Januar").Cells(i, 20).Copy Worksheets("Drucken").Cells(38, 19)
        Worksheets("Januar").Cells(i, 21).Copy Worksheets("Drucken").Cells(38, 20)
        Worksheets("Januar").Cells(i, 22).Copy Worksheets("Drucken").Cells(38, 21)
        Worksheets("Januar").Cells(i, 23).Copy Worksheets("Drucken").Cells(38, 22)
        Worksheets("Januar").Cells(i, 24).Copy Worksheets("Drucken").Cells(38, 23)
        Worksheets("Januar").Cells(i, 25).Copy Worksheets("Drucken").Cells(38, 24)
        Worksheets("Januar").Cells(i, 26).Copy Worksheets("Drucken").Cells(38, 25)
        Worksheets("Januar").Cells(i, 27).Copy Worksheets("Drucken").Cells(38, 26)
        Worksheets("Januar").Cells(i, 28).Copy Worksheets("Drucken").Cells(38, 27)
        Worksheets("Januar").Cells(i, 29).Copy Worksheets("Drucken").Cells(38, 28)
        Worksheets("Januar").Cells(i, 30).Copy Worksheets("Drucken").Cells(38, 29)
        Worksheets("Januar").Cells(i, 31).Copy Worksheets("Drucken").Cells(38, 30)
        Worksheets("Januar").Cells(i, 32).Copy Worksheets("Drucken").Cells(38, 31)
        Worksheets("Januar").Cells(i, 33).Copy Worksheets("Drucken").Cells(38, 32)
End If
Next

But I think with for next loops its way better. But I dont know why its not working with the code above...

Try the next code, please. I only hope that I could understand what you (really) need:

Sub testIterations()
 Dim i As Long, j As Long, k As Long

 k = 2
 For i = 7 To 37
    If Worksheets("Januar").cells(i, 2).value = Worksheets("Drucken").cells(12, 12).value Then
        For j = 3 To 5
            'Worksheets("Januar").cells(i, j).Copy Worksheets("Drucken").cells(38, k)
            Worksheets("Drucken").cells(38, k).value = Worksheets("Januar").cells(i, j).value
            k = k + 1
        Next
    End If
 Next
End Sub

If my understanding is correct, do you need copying the format, too? Or only the values will be enough. If only the values, the code can be much faster, not involving the clipboard.

Based on the edit to the post: I'd use this code,

Sub Test3()
    Dim i As Long
    Dim j As Long
        For i = 7 To 37
            If Worksheets("Januar").Cells(i, 2) = Worksheets("Drucken").Cells(12, 12) Then
                For j = 1 To 30
                    Worksheets("Drucken").Cells(38, j + 1) = Worksheets("Januar").Cells(i, j + 2)
                Next j
            End If
        Next i
End Sub

Original answer left for informational purposes

The code below will copy your entire row and paste to so the second sheet based on the criteria in xlCellTest using your code above I set it to the same cell as you have but suggest against that cell as it could be overwritten

Sub test2()
    Dim xlCellA As Range
    Dim xlCellB As Range
    Dim xlCellTest As Range
        Set xlCellTest = Worksheets("Drucken").Cells(12, 12)
        Set xlCellA = Worksheets("Januar").Range("B2")
        Set xlCellB = Worksheets("Drucken").Range("A2")
        Do Until xlCellA = ""
            If xlCellA = xlCellTest Then
                xlCellA.EntireRow.Copy
                xlCellB.PasteSpecial xlPasteAll
                Set xlCellB = xlCellB.Offset(1, 0)
            End If
            Set xlCellA = xlCellA.Offset(1, 0)
        Loop
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM