Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailem Excel VBA - vytvoření databáze

Sub Kopirovani()

Sheets("Přehled").Select

Application.ScreenUpdating = False ' zrychluje makro

y = Range("B3").End(xlDown).Row ' PosledniZapsanyRadek

For i = y To 3 Step -1 ' uloží do i poslední zapsaný řádek , který nalezl jako y, a začně cyklus, začíná od třetího řádku dolů

    If Cells(i, 10) = "KKY" Then '10 je označení sloupce J -> rozeznává v jaké se hráč nachází skupině
         Range(Cells(i, 2), Cells(i, 11)).Copy
         Sheets("KKY").Select
         x = Range("B1").End(xlDown).Row + 1
         Cells(x, 2).Select
         ActiveSheet.Paste
    ElseIf Cells(i, 10) = "ZCI" Then
        Range(Cells(i, 2), Cells(i, 11)).Copy
        Sheets("ZCI").Select
         x = Range("B1").End(xlDown).Row + 1
        Cells(x, 2).Select
        ActiveSheet.Paste
    ElseIf Cells(i, 10) = "MZKY" Then
        Range(Cells(i, 2), Cells(i, 11)).Copy
        Sheets("MZKY").Select
         x = Range("B1").End(xlDown).Row + 1
        Cells(x, 2).Select
        ActiveSheet.Paste
    ElseIf Cells(i, 10) = "JAROŠOV" Then
        Range(Cells(i, 2), Cells(i, 11)).Copy
        Sheets("JAROŠOV").Select
         x = Range("B1").End(xlDown).Row + 1
        Cells(x, 2).Select
        ActiveSheet.Paste
    ElseIf Cells(i, 10) = "PŘÍPRAVKY" Then
        Range(Cells(i, 2), Cells(i, 11)).Copy
        Sheets("PŘÍPRAVKY").Select
         x = Range("B1").End(xlDown).Row + 1
        Cells(x, 2).Select
        ActiveSheet.Paste
    ElseIf Cells(i, 10) = "JKY" Then
        Range(Cells(i, 2), Cells(i, 11)).Copy
        Sheets("JKY").Select
         x = Range("B1").End(xlDown).Row + 1
        Cells(x, 2).Select
        ActiveSheet.Paste
    ElseIf Cells(i, 10) = "ZKY" Then
        Range(Cells(i, 2), Cells(i, 11)).Copy
        Sheets("ZKY").Select
         x = Range("B1").End(xlDown).Row + 1
        Cells(x, 2).Select
        ActiveSheet.Paste
    ElseIf Cells(i, 10) = "JUNI" Then
        Range(Cells(i, 2), Cells(i, 11)).Copy
        Sheets("JUNI").Select
         x = Range("B1").End(xlDown).Row + 1
        Cells(x, 2).Select
        ActiveSheet.Paste
    ElseIf Cells(i, 10) = "" Then
    
    End If
Next i

Application.ScreenUpdating = True ' zrychluje makro

End Sub

díky za připomínky, místo row jsem tedy použil range a cells jak si radil a už kopíruju ty buňky jaké chci, nicméně kód uplně nefunguje, kopíruje pouze ty řádky, které mají shodný sloupec L jako uplně prvně nalezený záznam. přitom ani nenakopíruje všechny a občas se tam nějaký záznam vyskytl víckrát, asi to je způsobeno těma else if jak říkáš, budu muset hledat nějaké elegantnější řešení , naštuduju si ten case. ale doufal jsem že i ten elseif bude fungovat.....

Reakce na odpověď

1 Zadajte svou přezdívku:
2 Napište svou odpověď:
3 Pokud chcete dostat ban, zadejte libovolný text:

Zpět do poradny