CODEWITHSUNDEEP
excelvbaloopsif-statementcopy-paste
Sam99
Sam99

Reputation: 3

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

Upvotes: 0

Views: 253

Answers (1)

Aldert
Aldert

Reputation: 4323

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

Upvotes: 1

Related Questions