copier cellules avec 1 critère

[ngs]

Bonsoir le forum,

Dans l'onglet "base" du fichier "source", je veux copier toutes les lignes qui contiennent le mois d'octobre 2013.
ensuite je veux les coller dans l'onglet "données" du fichier "trades-10-2013".

Ci-joint les 2 fichiers.
Ci-dessous les macros que j'ai mais çà ne marche pas.

Merci pour votre aide.

1 ère solution :

Sub datas()
Dim i, k As Integer
Dim WBK As String
Dim WBK2 As String
Dim ws As String
Dim ws2 As String
Dim mths As Variant
Dim mt, da, yr As Variant

Dim plage As Range, cells As Range

ws = "base"
ws2 = "trades"
WBK = "source.xls"

da = Month(Workbooks(WBK).Sheets(ws).Range("C1"))

mt = Month(Workbooks(WBK).Sheets(ws).Range("C1"))
yr = Year(Workbooks(WBK).Sheets(ws).Range("C1"))

WBK2 = "Trades" & "-" & mt - 1 & "-" & yr & ".xls"

Sheets(ws).Select

For i = 3 To 10
Select Case Workbooks(WBK).Sheets(ws).cells(i, 3).Value
Case " da & " - " & (mt - 1) & " - " & yr "
cells(i, 3).EntireRow.Copy
End Select

Workbooks.Open Filename:="C:\Lien\" & WBK2
Sheets(ws2).Select
Range("A2").Select
ActiveSheet.Paste

Next i
End Sub




2ème solution :
Sub datas2()

Dim i, k As Integer
Dim WBK As String
Dim WBK2 As String
Dim ws As String
Dim ws2 As String
Dim mths As Variant
Dim mt, da, yr As Variant

Dim plage As Range, cells As Range


ws = "base"
ws2 = "trades"
WBK = "source.xls"

da = Month(Workbooks(WBK).Sheets(ws).Range("C1"))

mt = Month(Workbooks(WBK).Sheets(ws).Range("C1"))
yr = Year(Workbooks(WBK).Sheets(ws).Range("C1"))

WBK2 = "Trades" & "-" & mt - 1 & "-" & yr & ".xls"

Sheets(ws).Select

mths = da & "-" & mt - 1 & "-" & yr
i = 3
With Worksheets(ws)

Set plage = Range("C3:C10")

For Each cells In plage
If cells(i, 3) = da & "-" & mt - 1 & "-" & yr Then
cells(i, 3).EntireRow.Copy
Workbooks.Open Filename:="C:\Lien\" & WBK2
Sheets(ws2).Select
Range("A2").Select
ActiveSheet.Paste

End If
Next cells

End With
End Sub

 

[Dranreb]

Re : copier cellules avec 1 critère

Bonjour.

Je le verrais comme ça :

Sub Datas()
Dim Dt As Date, Mois As Long, An As Long, PLgSource As Range, FeuiCible As Worksheet
Dt = Feuil1.[C1].Value
Dt = DateSerial(Year(Dt), Month(Dt), 0)
Mois = Month(Dt): An = Year(Dt)
Workbooks.Open Filename:="C:\Lien\Trades" & "-" & Mois & "-" & An & ".xls"
Set FeuiCible = ActiveWorkbook.Worksheets(1)
Set PLgSource = Feuil1.[A2].Resize(Feuil1.[A65000].End(xlUp).Row - 1, 3)
PLgSource.Columns(4).FormulaR1C1 = "=1/AND(MONTH(RC3)=" & Mois & ",YEAR(RC3)=" & An & ")"
Intersect(PLgSource.Columns(4).SpecialCells(xlCellTypeFormulas, 1).EntireRow, _
   PLgSource).Copy Destination:=FeuiCible.[A2]
PLgSource.Columns(4).ClearContents
End Sub

 

[ngs]

Re : copier cellules avec 1 critère

Bonsoir Dranreb,
Merci pour ton aide.
Le choix de la date est variable (entre janvier et décembre). J'a essayé de modifier directement (par exemple le mois de septembre) sur excel et le résultat retourné est octobre.

Alors comment faire?
Merci

 

[Dranreb]

Re : copier cellules avec 1 critère

Le problème c'est qu'il n'y a pas de données en aout or ce sont bien les données du mois précédent celui en C1 qu'il faut puisque vous disiez que vous vouliez octobre alors que la date en C1 était de novembre ?
Il ne copie pas octobre: il oublie de le supprimer !

Sub Datas()
Dim Dt As Date, Mois As Long, An As Long, PLgSource As Range, FeuiCible As Worksheet
Dt = Feuil1.[C1].Value
Dt = DateSerial(Year(Dt), Month(Dt), 0)
Mois = Month(Dt): An = Year(Dt)
Workbooks.Open Filename:="C:\Lien\Trades-" & Mois & "-" & An & ".xls"
Set FeuiCible = ActiveWorkbook.Worksheets(1)
Set PLgSource = Feuil1.[A2].Resize(Feuil1.[B65000].End(xlUp).Row - 1, 3)
PLgSource.Columns(4).FormulaR1C1 = "=1/AND(MONTH(RC3)=" & Mois & ",YEAR(RC3)=" & An & ")"
FeuiCible.[2:500].Delete
On Error Resume Next
Intersect(PLgSource.Columns(4).SpecialCells(xlCellTypeFormulas, 1).EntireRow, _
   PLgSource).Copy Destination:=FeuiCible.[A2]
On Error GoTo 0
PLgSource.Columns(4).ClearContents
End Sub

 

[ngs]

Re : copier cellules avec 1 critère

Le problème c'est qu'il n'y a pas de données en aout or ce sont bien les données du mois précédent celui en C1 qu'il faut puisque vous disiez que vous vouliez octobre alors que la date en C1 était de novembre ?
Il ne copie pas octobre: il oublie de le supprimer !

Sub Datas()
Dim Dt As Date, Mois As Long, An As Long, PLgSource As Range, FeuiCible As Worksheet
Dt = Feuil1.[C1].Value
Dt = DateSerial(Year(Dt), Month(Dt), 0)
Mois = Month(Dt): An = Year(Dt)
Workbooks.Open Filename:="C:\Lien\Trades-" & Mois & "-" & An & ".xls"
Set FeuiCible = ActiveWorkbook.Worksheets(1)
Set PLgSource = Feuil1.[A2].Resize(Feuil1.[B65000].End(xlUp).Row - 1, 3)
PLgSource.Columns(4).FormulaR1C1 = "=1/AND(MONTH(RC3)=" & Mois & ",YEAR(RC3)=" & An & ")"
FeuiCible.[2:500].Delete
On Error Resume Next
Intersect(PLgSource.Columns(4).SpecialCells(xlCellTypeFormulas, 1).EntireRow, _
   PLgSource).Copy Destination:=FeuiCible.[A2]
On Error GoTo 0
PLgSource.Columns(4).ClearContents
End Sub

ok,


Merci beaucoup pour ton retour.
bonne soirée