Inserisci riga sopra, copia dati e aggiungi testo

[BG66]

Ciao a tutti.
Volevo, semplicemente, quando avvio la macro:
a) creare un riga vuota sopra la riga (ora n°7) con il testo "riga in corso"
b) copiare solamente i valori di riga in corso -> B7:M7 ( nell'originale il numero è il frutto di una formula con somma)
c) nella colonna A inserire il testo anno 2021 ( in pratica prendere il nome dalla celle che la precede incrementando di uno).

Ma non sapendo come fare a dire prendi questa riga a prescindere se oggi è la numero 7 e fra un anno è la numero 8.
Ho fatto, ovviamente un giro contorto!!!

Nell'esempio allegato partendo dalla riga 7 con questo script aggiungo una riga sopra quello che seleziono:

Codice: Seleziona tutto

Sub InserisciSopra()

    Dim i As Long
    Dim xLast As Long
    Dim xRng As Range
    Dim xTxt As String
    On Error Resume Next
    xTxt = Application.ActiveWindow.RangeSelection.Address
    Set xRng = Application.InputBox("Seleziona la cella", "Inserisci riga", xTxt, , , , , 8)
    If xRng Is Nothing Then Exit Sub
    If (xRng.Columns.Count > 1) Then
        MsgBox "Devi selezionare una sola cella", , "AVVISO"
        Exit Sub
    End If
    xLast = xRng.Rows.Count
    For i = xLast To 1 Step -1
      If InStr(1, xRng.Cells(i, 1).Value, "riga in corso") > 0 Then
        Rows(xRng.Cells(i, 1).Row).Insert shift:=xlDown
      End If
    Next
End Sub


poi copio i valori:

Codice: Seleziona tutto

Sub CopiaValori1()
Dim CopyRng As Range, PasteRng As Range
xTitleId = "Copia Valori"
Set CopyRng = Application.Selection
Set CopyRng = Application.InputBox("Range da copiare", xTitleId, CopyRng.Address, Type:=8)
Set PasteRng = Application.InputBox("Cella di destinazione", xTitleId, Type:=8)
CopyRng.Copy
PasteRng.Parent.Activate
PasteRng.PasteSpecial xlPasteValuesAndNumberFormats
'PasteRng.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End Sub

Mentre non sono riuscito a fare la parte del testo.
https://www.dropbox.com/scl/fi/s36s9r0k5owk81dlkjwdt/Ore_estratto_forum.xlsm?dl=0&rlkey=8zgnl6zlm76yrdvoxqekyn1ro

Grazie per l'aiuto.
Gene

[Marius44]

Ciao Gene
Sicuramente ho capito male ma non sarebbe sufficiente, se la riga da inserire è sempre sopra l'ultima valorizzata, questa macro:

Codice: Seleziona tutto

Sub Insert_Copy()
ur = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Rows(ur & ":" & ur).Insert shift:=xlDown
Rows(ur + 1 & ":" & ur + 1).Copy
Rows(ur & ":" & ur).PasteSpecial Paste:=xlPasteValues
End Sub


Poi provvedi a cambiare la dicitura nella col.A

Ciao,
Mario

[Anthony47]

Una possibile alternativa a quanto proposto da Mario (vedi sopra):

Codice: Seleziona tutto

Sub BGgg()
Dim RiC As Long
'
RiC = Evaluate("=MAX((A1:A1000=""riga in corso"")*(ROW(A1:A1000)))")
If RiC > 0 And Rows(RiC).Cells(0, 1) <> "" Then
    With Rows(RiC)
        .Insert Shift:=xlDown                                       'Inserisce riga
        .Cells(1, 2).Resize(1, 12).Copy                             'Copia...
        .Cells(1, 2).Offset(-1, 0).PasteSpecial xlPasteValues       '... e incolla valori
        .Cells(1, 2).Resize(1, 12).ClearContents                    'Per azzerare la vecchia "riga in corso"
        .Cells(1, 1).Offset(-2, 0).Copy .Cells(1, 1).Offset(-1, 0)  'Copia la data
    End With
End If
End Sub

Come prerequisiti, affinche' la copia della data funzioni correttamente, e' che in A3 scrivi solo il numero dell'anno (2017), mentre in A4 scrivi la formula =A3+1 (da copiare verso il basso fino all'ultima cella che gia' contiene un anno.
Poi formatti l'area A3:Axx (l'ultima riga con data) con il formato Numero /Personalizzato e come "Tipo" scrivi "Anno " #.##0

Il suddetto codice cancella il contenuto di "riga corrente"; se invece la riga va mantenuta (es perche' contiene formule) allora devi cancellare la riga con "ClearContents"

Ciao

[BG66]

Ciao.
Siete mitici.
Per la cronaca ho usato lo script di Anthony ..... perchè aveva... qualche riga in più.... e quindi mi faceva sentire meno pollo

...Scherzi a parte.... grazie mille ad entrambi...come al solito!!!

Alla prossima
Gene