Search code examples
excelvbaloopsif-statementcopy-paste

Loop with if statement and copy paste


I am trying to copy paste from a master sheet into a max of three sheets that's why I have three values.

This code does what it should with column "C".

My sheet goes till "BO" and it will grow longer.
I could copy paste my code and change all "C" to "D" and so on but I can't imagine how long the code will be at the end.

I want to try a loop. I didn't find a good explanation on how I loop something like this.

Sub autocopyrechts()

Dim score As String
Dim score1 As String
Dim score2 As String
score2 = Range("C7").Value
score1 = Range("C6").Value
score = Range("C5").Value

If score = ("MP") Then
    Tabelle1.Range("C1:C354").Copy
    Tabelle7.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial

ElseIf score = ("M") Then
    Tabelle1.Range("C1:C354").Copy
    Tabelle5.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial

ElseIf score = ("MI") Then
    Tabelle1.Range("C1:C354").Copy
    Tabelle6.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial

ElseIf score = ("Z") Then
    Tabelle1.Range("C1:C354").Copy
    Tabelle8.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial

ElseIf score = ("PK") Then
    Tabelle1.Range("C1:C354").Copy
    Tabelle9.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial

ElseIf score = ("G") Then
    Tabelle1.Range("C1:C354").Copy
    Tabelle10.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial

End If

If score1 = ("MP") Then
    Tabelle1.Range("C1:C354").Copy
    Tabelle7.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial

ElseIf score1 = ("M") Then
    Tabelle1.Range("C1:C354").Copy
    Tabelle5.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial

ElseIf score1 = ("MI") Then
    Tabelle1.Range("C1:C354").Copy
    Tabelle6.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial

ElseIf score1 = ("Z") Then
    Tabelle1.Range("C1:C354").Copy
    Tabelle8.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial

ElseIf score1 = ("PK") Then
    Tabelle1.Range("C1:C354").Copy
    Tabelle9.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial

ElseIf score1 = ("G") Then
    Tabelle1.Range("C1:C354").Copy
    Tabelle10.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial

End If

If score2 = ("MP") Then
    Tabelle1.Range("C1:C354").Copy
    Tabelle7.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial

ElseIf score2 = ("M") Then
    Tabelle1.Range("C1:C354").Copy
    Tabelle5.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial

ElseIf score2 = ("MI") Then
    Tabelle1.Range("C1:C354").Copy
    Tabelle6.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial

ElseIf score2 = ("Z") Then
    Tabelle1.Range("C1:C354").Copy
    Tabelle8.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial

ElseIf score2 = ("PK") Then
    Tabelle1.Range("C1:C354").Copy
    Tabelle9.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial

ElseIf score2 = ("G") Then
    Tabelle1.Range("C1:C354").Copy
    Tabelle10.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial

End If

End Sub

Solution

  • Instead of using Range, you can use Cell in your code and have a rowCounter keeping track of what row you are working with.

    Dim score As String
    Dim rowCounter as Integer
    
    for rowCounter = 5 to 7
        score = Cells(rowCounter, 3).Value
        Tabelle1.Range("C1:C354").Copy
        Select Case score
            case "MP": Tabelle7.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial
            case "M" : Tabelle5.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial
            case "MI" : Tabelle6.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial
            case "Z" : Tabelle8.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial
            case "PK" : Tabelle9.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial
            case "G" : Tabelle10.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial
        End Select
    Next
    

    Hope this works for you and concept is clear