Incrémentation et Copie Colonne De La Feuille Précédente

marfipo

XLDnaute Occasionnel
Bonjour à tous,
dans le fichier ci-joint j'ai un code qui fait l'incrémentation des onglets par mois en cliquant sur le bouton (ajouter un mois) sans aucun souci. mais je veux le modifier pour copier les valeurs de la colonne J de la feuille précédente dans la colonne H de la feuille copiée.
ce que j'ai pu faire c'est de copier juste la cellule J9 de la feuille précédente dans H9 de la feuille copiée comme vous pouvez le constater en rajoutant ce code dans la dernière partie du module

Dim Sd
Set Sd = Range("J9")
Range("H9") = Sd

est ce que quelqu'un peut m'aider pour que je puisse incrémenter et copier la colonne J de la feuille précédente dans la colonne H de la feuille copiée et de faire la même chose à chaque fois je rajoute une nouvelle feuille ??
 

Pièces jointes

  • Matériel fd.xlsm
    90.1 KB · Affichages: 49
Dernière édition:

CHALET53

XLDnaute Barbatruc
Re : Incrémentation et Copie Colonne De La Feuille Précédente

bonjour,

Essaie ce code :

Sub NewMonth_Sheet()
Dim lSht As Worksheet
Dim nSht As Worksheet
Dim shName As String
Dim Cel As Range, I As Long


Set lSht = Sheets(Sheets.Count)
a = lSht.Name
If IsDate(lSht.Name) Then

shName = Application.Proper(Format(DateAdd("m", 1, lSht.Name), "mmmm-yyyy"))
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On Error Resume Next 'Tests that sheet doesn't already exist
Set nSht = Sheets(shName)
On Error GoTo 0

Sheets("Total Général").Activate
Range("D" & Cells(Rows.Count, 4).End(xlUp).Row - 1).EntireRow.Copy
Range("A" & Cells(Rows.Count, 4).End(xlUp).Row).EntireRow.Insert Shift:=xlDown
Application.CutCopyMode = False

If nSht Is Nothing Then
lSht.Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = shName
Else
MsgBox "Sheet """ & shName & """ already exists!", vbCritical
End If
Else
MsgBox "Last sheet name does not" & Chr(10) & "represent a month!", vbCritical: Exit Sub
End If


For I = 35 To 9 Step -1
If IsDate(Cells(I, "E").Value) Then Cells(I, "E").EntireRow.Delete
Next I

Sheets(a).Select
Range("J9:J34").Select
Selection.Copy
Sheets(shName).Select

Sheets(shName).Select
Range("H9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False




Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub



a+
 

Discussions similaires