Transfert de données entre feuilles vec condition

Option Explicit

Sub testtransfert()

Dim i As Integer, dl As Integer 'déclaration des variables

dl = Sheets("DQE").Range("B" & Rows.Count).End(xlUp).Row 'définition de la variable

With Sheets("BASE DE DONNEES") 'à partir de la feuille BASE DE DONNEES

For i = 2 To 1000 'boucle des lignes 2 à 1000 (à adapter)

If .Range("A" & i) = "ý" Then 'si la colonne A contient une croix

.Range("B" & i & ":G" & i).Copy Sheets("DQE").Range("B" & dl) 'on copie de B à G sur la feuille DQE

dl = dl + 1

End If

Next i

End With

End Sub

Salut s' ils vous plaît, est-ce que quelqu'un peux modifier le code ci dessus pour moi, au fait je veux copier des données depuis une feuille Excel nommé GROS ŒUVRES de F50 à J83 à condition que la colonne D50 á D83 contiennent le chiffre 2 vers une autre feuille Excel nommé M de D4 à H11. Merci pour ta compréhension.

Bonjour Tinolacoro, le forum,

Tu aurais du poster dans la section EXCEL-VBA.

Un petit fichier peut-être pour voir comment sont structurés tes données ?

Cordialement,

Voici joint le fichier du projet cher xorsankukai

Bonjour Tinolacoro, le forum,

je veux copier des données depuis une feuille Excel nommé GROS ŒUVRES de F50 à J83 à condition que la colonne D50 á D83 contiennent le chiffre 2 vers une autre feuille Excel nommé M de D4 à H11

A tester:

Sub transfertM()
 Dim FSource As Worksheet, Fdest As Worksheet
 Dim i%, j%

 Set FSource = Sheets("GROS OEUVRES")
 Set Fdest = Sheets("M")
     Fdest.Range("E4:I11,E13:I21").ClearContents

     Application.ScreenUpdating = False

  With FSource
    i = 50: j = 4
    Do While i <= 83
     If .Range("D" & i).Value = 2 Then
        .Range("F" & i & ":J" & i).Copy
         Fdest.Range("E" & j).PasteSpecial Paste:=xlPasteValues
         j = j + 1
     End If
    i = i + 1
   Loop
  End With
  Application.CutCopyMode = False
End Sub

Cordialement,

Merci je vais ajouté le code et te revenir

Merci infiniment Monsieur xorsankukai, le code est parfait, tu est vraiment doué en visual basique.

Il y'a problème, en ajoutant 6 autres lignes, le transfert de données laisse un espace vide entre copie

je veux copier des données depuis une feuille Excel nommé GROS ŒUVRES vers vers une autre feuille Excel nommé M dans les cas suivant

1--de F50 à J84 vers E4 à I14 à condition que la colonne D50 á D83 contiennent le chiffre 1

2-- de F120 à J154 vers E15 à i25 à condition que de la colonne D120 à J154 contiennent 1

3---de F50 à J154 vers E28 à E38 à condition que la colonne D50 á D154 contiennent 2.

Voir le fichier joints

J'ai du mal à modifier le code que xorsankukai m'a élaborer, je suis vraiment très faible en VBA, pourtant j'aime bien les programmations .

Merci d'avance

S'il vous plaît quelqu'un peut corriger ce code la pour moi.

Sub copie()

Sheets("M").Range("E4:E25;E28:E38").ClearContents

Application.ScreenUpdating = False

WHITE Sheets("GROS OEUVRES")
If .Range("D50:D84") = 1 Then
Range("F50:J84").Copy
Sheets("M").Range("E4").PasteSpecial Paste:=xlPasteValues
End If
Sheets("GROS OEUVRES").Select
If .Range("D120:D154") = 1 Then
.Range("F120:J154").Copy
Sheets("M").Range("E15").PasteSpecial Paste:=xlPasteValues
End If
Sheets("GROS OEUVRES").Select
If .Range("D50:D154") = 2 Then
.Range("F50:J154").Copy
Sheets("M").Range("E28").PasteSpecial Paste:=xlPasteValues
End If
Application.CutCopyMode = False
End Sub

Bonjour Tinolacoro, le forum,

Pas trop le temps en ce moment, mais essaie ce code:

Sub transfertM()
 Dim FSource As Worksheet, Fdest As Worksheet
 Dim i%, j%

 Set FSource = Sheets("GROS OEUVRES")
 Set Fdest = Sheets("M")
     Fdest.Range("E4:I25,E28:I38").ClearContents

  Application.ScreenUpdating = False

  With FSource
    i = 50: j = 4  '............................fenêtres RDC
    Do While i <= 83
     If .Range("D" & i).Value = 1 And .Range("F" & i) <> "" Then
        .Range("F" & i & ":J" & i).Copy
         Fdest.Range("E" & j).PasteSpecial Paste:=xlPasteValues
         j = j + 1
     End If
    i = i + 1
   Loop

   i = 120: j = 15 '...........................fenêtres étage
    Do While i <= 154
     If .Range("D" & i).Value = 1 And .Range("F" & i) <> "" Then
        .Range("F" & i & ":J" & i).Copy
         Fdest.Range("E" & j).PasteSpecial Paste:=xlPasteValues
         j = j + 1
     End If
    i = i + 1
   Loop

   i = 50: j = 28 '............................portes RDC & étage
    Do While i <= 154
     If .Range("D" & i).Value = 2 And .Range("F" & i) <> "" Then
        .Range("F" & i & ":J" & i).Copy
         Fdest.Range("E" & j).PasteSpecial Paste:=xlPasteValues
         j = j + 1
     End If
    i = i + 1
   Loop
  End With
  Application.CutCopyMode = False
End Sub

J'ai rajouté une condition (.range("F"&i)<>"") car en ligne 96 tu as un 2 mais aucune données de F à J ce qui donne une ligne vide sur la feuille M.

Cordialement,