Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailemVyřešeno Excel VBA - Formátovanie

Toto vlákno som nejako prehliadol, takže ak je to ešte aktuálne, tak daj vedieť a napíšem ti aj to druhé makro. Prvé makro by mohlo vyzerať takto:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim aRange As Range
    Dim srcWorksheet As Worksheet
    Dim srcFirstCell As Range
    Dim srcLastCell As Range
    Dim dstWorksheet As Worksheet
    Dim dstCell As Range

    Set aRange = Intersect(Target, Range("D17,D20"))
    If Not aRange Is Nothing Then
        Set srcWorksheet = Worksheets("PrvaSK4")
        Set dstWorksheet = Worksheets("PTPRVA")
        dstWorksheet.Cells.Clear

        Set dstCell = dstWorksheet.Range("A1")
        Set srcFirstCell = srcWorksheet.Range("B3")
        For i = 1 To Range("D17")
            Set srcLastCell = srcFirstCell.Offset(Range("D20") - 1, 1)
            srcWorksheet.Range(srcFirstCell, srcLastCell).Copy dstCell

            Set dstCell = dstCell.Offset(0, 2)
            If i Mod 12 = 0 Then
                Set dstCell = dstCell.Offset(Range("D20") + 1, -dstCell.Column + 1)
                If dstCell.Row <= 44 And dstCell.Row + Range("D20") > 44 Then
                    Set dstCell = dstCell.Offset(44 - dstCell.Row + 1)
                End If
            End If

            Set srcFirstCell = srcFirstCell.Offset(0, 3)
        Next i
        dstWorksheet.Cells.ClearFormats
    End If
End Sub

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