Bonjour,
je recherche à faire une macro pour extraire d'un fichier excel quelques feuilles en valeur afin d'obtenir un extrait du fichier originel.
Classeur 1 composé de 4 feuilles
Extrait de la feuille 1 en valeur dans un nouveau classeur Excel idéalement nommé avec la valeur de la case "C1"
Je rencontre des difficultés avec 3 choses :
- Ma feuille 1 contient des données filtrés je souhaite que l'extrait ne contiennent que les données affichés
- Ma feuille 1 contient des mise en page comme des cellules fusionnées, hors la copie de cellule fusionnées semble impossible.
- Ma feuille 1 dispose d'un celulle "C1" titre basé sur la concaténation de texte ainsi que du nom du filtre appliqué sur ma feuille (récupérer par formule)
Ma formule pour C1 :
Citation :
"VAGUE "&(RIGHT(AutoFilter_Criteria(A7);(LEN(AutoFilter_Criteria(A7))-FIND("=";AutoFilter_Criteria(A7)))))&" du "&TEXT(VLOOKUP((RIGHT(AutoFilter_Criteria(A7);(LEN(AutoFilter_Criteria(A7))-FIND("=";AutoFilter_Criteria(A7)))));Créneaux!A2:B20;2;FALSE);"[$-40C]jjjj j mmmm aaaa" )
|
Cette fonction m'affiche "Vague " suivi du nom de filtre de la colonne A contenue dans A7, obtenue par macro (code ci dessous) ainsi que la Date de la Vague correspondant au filtre contenue dans un tableau en feuille "Créneaux"
Exemple C1 : VAGUE 3 du dimanche 3 février 2013
Code Autofilter :
Code :
- Function AutoFilter_Criteria(Header As Range) As String
- Dim strCri1 As String, strCri2 As String
- Application.Volatile
- With Header.Parent.AutoFilter
- With .Filters(Header.Column - .Range.Column + 1)
- If Not .On Then Exit Function
- strCri1 = .Criteria1
- If .Operator = xlAnd Then
- strCri2 = " ET " & .Criteria2
- ElseIf .Operator = xlOr Then
- strCri2 = " OU " & .Criteria2
- End If
- End With
- End With
- AutoFilter_Criteria = UCase(Header) & ": " & strCri1 & strCri2
- End Function
|
Et mon code qui ne fonctionne pas pour exporter en valeur la feuille 1 :
Code :
- Sub SaveSheet()
- ActiveSheet.Copy
- With ActiveSheet.UsedRange
- .Copy
- .PasteSpecial xlValues
- .PasteSpecial xlFormats
- End With
- Application.CutCopyMode = False
- Dim DTAddress As String
- DTAddress = CreateObject("WScript.Shell" ).SpecialFolders("Desktop" ) & Application.PathSeparator
- ActiveWorkbook.SaveAs DTAddress & Range("C1" ) & " " & Format(Date, "mmmmddyyyy" ) & " " & Format(Time, "HHMM" ), FileFormat:= _
- xlNormal
- End Sub
|
L'erreur est la suivante : Run-time error '1004': Cannot change part of a merge cell.
Récapitulation du point qui ne bloque : La copie des cellules fusionnées
En vous remerciant par avance de toutes remarques ou aide.
Cdt,
Message édité par MATAMATA le 30-01-2013 à 11:37:49
