2 pièce(s) jointe(s)
Copy Coller avec AdvancedFilter
Bonjour
voici le code suivant qui utilise option AdvancedFilter pour Copier et Coller vers une autre feuil.
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
| Option Explicit
Sub Copy_Avec_AdvancedFilter()
Dim ShGrLvr As Worksheet, ShMsq As Worksheet
Dim RgData As Range, RgCriter As Range, Rg As Range
Dim DerLig As Long, LastRow As Long
Set ShGrLvr = ThisWorkbook.Worksheets("Grand livre")
Set ShMsq = ThisWorkbook.Worksheets("40120")
Set RgData = ShGrLvr.Range("TablGrLivre[#All]")
Set RgCriter = ShGrLvr.Range("TablCritere[#All]")
DerLig = ShGrLvr.Cells(ShGrLvr.Rows.Count, 1).End(xlUp).Row
LastRow = ShMsq.Cells(ShMsq.Rows.Count, 1).End(xlUp).Row + 1
RgData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=RgCriter, CopyToRange:=ShMsq.Cells(LastRow, 1)
ShMsq.Rows(LastRow & ":" & LastRow).Delete Shift:=xlUp
Application.CutCopyMode = False
End Sub |
Svp j'ai deux questions
1- est ce que je peux copier sans l’entête
Pièce jointe 573891
2- est ce que je peux coller les cellules copier dans la cellule A9 par exemple et sans écraser les cellule existant
pour ce la j'ai essayer de modifier mon code et changer cette ligne de code
Code:
RgData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=RgCriter, CopyToRange:=ShMsq.Cells(LastRow, 1)
par
Code:
RgData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=RgCriter, CopyToRange:=ShMsq.Cells(9, 1)
et voila le message d'erreur
Pièce jointe 573892
