Home > Blockchain >  Vba Loop with if statement and copy Paste
Vba Loop with if statement and copy Paste

Time:08-04

Hey first time here but I don't know what to do tbh, so I am trying to make a code to copy paste stuff from the master sheet into the right sheet where it needs to be to a max of 3 different sheets that's why I ave 3 values.

I know it's kinda messy and I wrote to much but hey its doing what it should kinda (it's my first time doing this please don't judge me too much).

The problem I have is this code just does what it should with column "C" and my sheet goes till "BO" and it will grow even longer at some point, I could just 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 so I wanted to try a loop and tbh I didn't find a good explanation on how I loop something like this.

Many thanks in advance.

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

CodePudding user response:

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

  • Related