I bet you tried to copy the whole column and couldn't do that a second time.

But sometimes, it's easier to use a loop--especially for code that's almost
identical.

(And I'd use Long's, not Integer's)

Anyway...

Option Explicit
Sub testme02()

Dim rng As Range
Dim dataWks As Worksheet
Dim AgendaWks As Worksheet
Dim DestCell As Range

Dim ColsToCopy As Variant
Dim iCtr As Long

ColsToCopy = Array("M", "AF", "AG")

Set dataWks = Worksheets("data")
Set AgendaWks = Worksheets("agenda")

with AgendaWks
.Range("a:b").ClearContents
'add that header
.Range("a1").Value = dataWks.Cells(1, ColsToCopy(1)).Value
end with

With dataWks
For iCtr = LBound(ColsToCopy) To UBound(ColsToCopy)
With AgendaWks
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
Set rng = .Range(.Cells(2, ColsToCopy(iCtr)), _
.Cells(.Rows.Count, ColsToCopy(iCtr)).End(xlUp))

If DestCell.Row + rng.Rows.Count .Rows.Count Then
'not enough room
MsgBox "too many rows"
Exit Sub
End If
rng.Copy _
Destination:=DestCell
Next iCtr
End With

With AgendaWks
.Range("a:a").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=.Range("B1"), Unique:=True
End With

End Sub


vincent trouche wrote:

Thanks for your answer Dave.

Well it makes a lot of sense just to paste before performing an advanced
filter from column A to column B. But then I got a problem with the
paste fonction : Run time error '1004' Info cannot be pasted because
copy area and paste area are not the same size...

After some research on this newsgroup here is the right way to put 3
columns into one column and keep only the unique values without too much
hassle :

Dim rng As Range
Dim rnga As Range
Dim rngb As Range
Dim rng2 As Range
Dim cLastRow As Integer
Dim nbligne As Integer

nbligne = Worksheets("Data").Cells(Rows.Count, "AG").End(xlUp).Row

MsgBox nbligne

Sheets("agenda").Columns(1).ClearContents

Sheets("Data").Select
Columns("M:M").Select
Selection.Copy
Sheets("agenda").Select
Range("A1").Select
ActiveSheet.Paste

MsgBox "ok CA"
cLastRow = Worksheets("agenda").Cells(Rows.Count, "A").End(xlUp).Row
MsgBox cLastRow

Sheets("Data").Select
Range("AF1:AF" & Range("A65536").End(xlUp).Row).Copy
Sheets("agenda").Select
Range("A" & cLastRow + 1).Select
ActiveSheet.Paste
Worksheets("agenda").Rows(cLastRow + 1).Delete

MsgBox "ok assigned"
cLastRow = Worksheets("agenda").Cells(Rows.Count, "A").End(xlUp).Row
MsgBox cLastRow

Sheets("Data").Select
Range("AG1:AG" & Range("A65536").End(xlUp).Row).Copy
Sheets("agenda").Select
Range("A" & cLastRow + 1).Select
ActiveSheet.Paste
Worksheets("agenda").Rows(cLastRow + 1).Delete

MsgBox "ok actual"
cLastRow = Worksheets("agenda").Cells(Rows.Count, "A").End(xlUp).Row
MsgBox cLastRow

With Sheets("agenda")
Set rng = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
rng.Advancedfilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("agenda").Range("B1"), Unique:=True

MsgBox "ok unique"
cLastRow = Worksheets("agenda").Cells(Rows.Count, "B").End(xlUp).Row
MsgBox cLastRow

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

--

Dave Peterson