Guru do Excel e Power BI

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("F:F")) Is Nothing Then
        Qtd = Target.Value
        Lin = Target.Row
        If IsNumeric(Qtd) Then
            Even = Application.EnableEvents
            Application.EnableEvents = False
            Range(Cells(Lin, 1), Cells(Lin, 14)).Copy
            Range(Cells(Lin, 1), Cells(Lin + Qtd - 1, 14)).Select: ActiveSheet.Paste
            If Qtd > 1 Then
                Cells(Lin, 7).Select:   Selection.Value = 1
                Selection.AutoFill Destination:=Range(Cells(Lin, 7), Cells(Lin + Qtd - 1, 7)), Type:=xlFillSeries
            End If
            Target.Select
        End If
        Application.EnableEvents = Even
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Count > 1 Then Exit Sub
 If Target.Column <> 6 Then Exit Sub
 On Error Resume Next
 Cells(Target.Row, 1).Resize(, 14).Copy Cells(Target.Row + 1, 1).Resize(Target.Value, 14)
End Sub

Option Explicit

Private Sub btExecuta_Click()

Dim W           As Worksheet
Dim UltCel      As Range
Dim vCartao     As String
Dim vDataVenda  As Date
Dim vParcelas   As Integer
Dim vValorTotal As Currency

Dim Ln          As Long
Dim Col         As Integer

Dim TransfLn    As Long
Dim TransfCol   As Integer

Dim A           As Integer
Dim VerDif      As Currency

Set W = Sheets("Plan1")
W.Select

W.Range("A2").Select

Set UltCel = W.Cells(W.Rows.Count, 1).End(xlUp)

Ln = 2
Col = 1
TransfLn = 2
TransfCol = 7

W.Range("G:J").EntireColumn.Delete

Do While ActiveCell.Row <= UltCel.Row

    VerDif = 0
    vCartao = W.Cells(Ln, Col).Value
    vDataVenda = W.Cells(Ln, Col + 1).Value
    vParcelas = W.Cells(Ln, Col + 2).Value
    vValorTotal = W.Cells(Ln, Col + 3).Value
    
    For A = 1 To vParcelas
    
        W.Cells(TransfLn, TransfCol).Value = vCartao
        W.Cells(TransfLn, TransfCol + 1).Value = "Parcela " & A
        W.Cells(TransfLn, TransfCol + 2).Value = vDataVenda + (A * 30)
        W.Cells(TransfLn, TransfCol + 3).Value = _
             Application.WorksheetFunction.Round(vValorTotal / vParcelas, 2)
        
        VerDif = VerDif + W.Cells(TransfLn, TransfCol + 3).Value
        
        TransfLn = TransfLn + 1
    
    Next A
    
    'Checar valor total da venda
    If VerDif < vValorTotal Then
        W.Cells(TransfLn - 1, TransfCol + 3).Value = _
            W.Cells(TransfLn - 1, TransfCol + 3).Value _
            + (vValorTotal - VerDif)
    ElseIf VerDif > vValorTotal Then
        W.Cells(TransfLn - 1, TransfCol + 3).Value = _
            W.Cells(TransfLn - 1, TransfCol + 3).Value _
            - (VerDif - vValorTotal)
    End If

    ActiveCell.Offset(1, 0).Select
    Ln = Ln + 1

Loop

W.Range("A1:D1").Copy Destination:=W.Range("G1")
W.Range("g2").CurrentRegion.EntireColumn.AutoFit

MsgBox "Processo concluído"
W.Range("A1").Select

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("F:F")) Is Nothing Then
        Qtd = Target.Value
        Lin = Target.Row
        If IsNumeric(Qtd) Then
            Even = Application.EnableEvents
            Application.EnableEvents = False
            Range(Cells(Lin, 1), Cells(Lin, 14)).Copy
            Range(Cells(Lin, 1), Cells(Lin + Qtd - 1, 14)).Select: ActiveSheet.Paste
            Application.EnableEvents = Even
            If Qtd > 1 Then
                Cells(Lin, 7).Value = 1
                Cells(Lin, 7).AutoFill Destination:=Range(Cells(Lin, 7), Cells(Lin + Qtd - 1, 7)), Type:=xlFillSeries
                Data = Cells(Lin, 11).Value
                Cells(Lin + 1, 11).Value = DateSerial(Year(Data), Month(Data) + 1, Day(Data))
            End If
            If Qtd > 2 Then
                Range(Cells(Lin, 11), Cells(Lin + 1, 11)).AutoFill Destination:= _
                Range(Cells(Lin, 11), Cells(Lin + Qtd - 1, 11))
            End If
            Target.Select
        End If
    End If

End Sub

Option Explicit

Sub OrdenaTabela()

    Dim TabelaAtividades As ListObject 
    
    Set TabelaAtividades = wshAtividadesDiarias.ListObjects("TB_AtividadesDiarias")
    
    With TabelaAtividades.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("TB_AtividadesDiarias[[#All],[Data]]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
...
...
...
    
    TabelaAtividades.Sort.SortFields.Clear
    
    Set TabelaAtividades = Nothing
        
End Sub