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

Takže celý ale celičičký tvoj kód

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).PasteSpecial xlPasteValues
         Sheets("Přehled").Select
    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).PasteSpecial xlPasteValues
        Sheets("Přehled").Select
    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).PasteSpecial xlPasteValues
        Sheets("Přehled").Select
    ElseIf Cells(i, 10) = "VKV" Then
        Range(Cells(i, 2), Cells(i, 11)).Copy
        Sheets("VKV").Select
         x = Range("B1").End(xlDown).Row + 1
        Cells(x, 2).PasteSpecial xlPasteValues
        Sheets("Přehled").Select
    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).PasteSpecial xlPasteValues
        Sheets("Přehled").Select
    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).PasteSpecial xlPasteValues
        Sheets("Přehled").Select
    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).PasteSpecial xlPasteValues
        Sheets("Přehled").Select
    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).PasteSpecial xlPasteValues
        Sheets("Přehled").Select
    Else: Cells(i, 10) = ""
    Sheets("Přehled").Select
    End If
    
Next i

Application.ScreenUpdating = True ' zrychluje makro


vyriešiš týmto:

For i = 3 To Sheets("Přehled").Range("B3").End(xlDown).Row
    Sheets("Přehled").Range("B" & i & ":K" & i).Copy (Sheets(Sheets("Přehled").Range("J" & i).Value).Range("B" & Sheets(Sheets("Přehled").Range("J" & i).Value).Range("B1").End(xlDown).Row + 1))
Next i

pred to si ešte daj to Smazání upravené podľa Machra a máš to

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