Import conditionné par valeurs colonne incluses dans inputbox

Bonjour,

Je cherche à importer dans un fichier de paye uniquement les données concernées par le mois de la paye.

Le seul moyen que j'ai trouvé serait de demander à l'utilisateur de saisir le numéro de la première semaine concernée par la paye et celui de la dernière semaine afin de pouvoir conditionner mon import de sorte à ce que seules les données dont le numéro de semaine est compris entre ces deux bornes soient importées.

Cependant ma tentative ne fonctionne pas, je soupçonne un problème de type de données que je n'arrive pas à résoudre, pourriez vous m'aider à comprendre mon erreur?

Je joints 2 fichiers pour que ce soit plus parlant et je colle le code ci après.

Merci par avance de votre aide.

Bonne journée

Sub ImporterDonneesSansOuvrir()

Dim Chemin As String, Fichier As String, S1 As Integer, S2 As Integer, origine As Workbook, ws1 As Worksheet, ws2 As Worksheet, i As Integer

S1 = InputBox("Saisie de la 1ère semaine ")

S2 = InputBox("Saisie de la 2ème semaine ")

'Chemin d'accès au répertoire contenant le fichier source des données

Chemin = "C:\Gestion des heures\"

'Nom du fichier source

Fichier = "Saisie_des_temps_hebdo.xlsm"

Set origine = Application.Workbooks.Open("C:\Gestion des heures\Saisie_des_temps_hebdo.xlsm")

Set ws1 = origine.Worksheets("base")

Set ws2 = origine.Worksheets("base_paye")

'Plage des données à importer Base!$A$1:$J$65000

ThisWorkbook.Names.Add "plage", _

RefersTo:="='" & Chemin & "[" & Fichier & "]Base'!$A$1:$J$65000"

'condition N° semaine compris entre S1 et S2

For i = 2 To 1000

If S1 <= CInt(Workbooks("Saisie_des_temps_hebdo.xlsm").Sheets("base").Cells(i, 10)) <= S2 Then

'Nom de la feuille destination onglet base2

With ThisWorkbook.Sheets("BASE2")

'Plage des données à importer [$A$1:$J$65000]

.[A1:J1000] = "=plage"

'Plage des données à importer [$A$1:$J$65000]

.[A1:J1000].Copy

End With

Else

End If

Next i

Salut Doudoubeh,

Tu trouveras ci-joint ton fichier modifié

J'ai remplacé tes InputBox par un UserForm demandant à l'utilisateur de saisir des balises n° de semaine ou date

Il faut aussi indiqué le chemin vers le fichier source

Je te laisse tester et revenir vers nous

A dispo

Bonjour Juice,

Merci beaucoup pour ton aide, ta méthode me semble parfaite, par contre en testant ton fichier, il bogue sur Range(txt).Copy (avec txt="A1:J1,A133:J133,A134:J134,...") et je ne comprend pas pourquoi.

Merci par avance de ton retour.

Re-

Pas normal que sa bug

Est-ce que les plages qui sont copiés est identique au fichier exemple ?

Pas de cellule fusionnée ; de colonne différente ; c'est bien sur la feuille 1 etc...

A dispo

Bonjour Juice,

Les plages à copier ne sont pas identiques que dans le fichiers que j'ai envoyé il y a beaucoup plus de lignes et après avoir fais plusieurs teste je pense que c'est la raison pour laquelle j'ai le message : "la méthode "range" de l'objet _global à échoué

En effet si je teste l'import entre 01/02/2019 et le 02/02/2019 ça fonctionne mais sur le mois complet j'ai à nouveau l'erreur.

Il y a peut être trop de caractères de sélectionnés dans le Range pour que cela fonctionne.

Du coup saurais-tu comment je pourrais copier les lignes souhaitées sans la méthode range?

Aussi, j'ai vérifié il n'y a pas de cellules fusionnées ou de colonnes différentes et il s'agit bien de la feuille 1.

Merci par avance de ton retour

Bonjour Doudoubeh,

doudoubeh a écrit :

Il y a peut être trop de caractères de sélectionnés dans le Range pour que cela fonctionne.

Il y a à la fois trop de caractères et trop de range a selectionner.

On change donc la macro 'Import' par :

Sub Import()
Dim Wb As Workbook, Ws As Worksheet
Workbooks.Open (WayFile)
Set Wb = ThisWorkbook
Set Ws = ActiveWorkbook.Worksheets(1)
If Ws.FilterMode Then Ws.ShowAllData
If T = 1 Then
    Ws.Cells(1, 2).CurrentRegion.AutoFilter _
    Field:=2, _
    Criteria1:=">=" & Format(D, "mm/dd/yy"), _
    Operator:=xlAnd, _
    Criteria2:="<=" & Format(F, "mm/dd/yy")
Else
    D = Val(D)
    F = Val(F)
    Ws.Cells(1, 10).CurrentRegion.AutoFilter _
    Field:=10, _
    Criteria1:=">=" & D, _
    Operator:=xlAnd, _
    Criteria2:="<=" & F
End If
Ws.AutoFilter.Range.Copy
Wb.Activate
Sheets.Add After:=ActiveSheet
Range("A1").Select
ActiveSheet.Paste
Columns("A:J").EntireColumn.AutoFit
Workbooks(NameFile).Close savechanges:=False
[A1].Select
End Sub

Avec cette méthode tu applique un filtre et tu copie le résultat

Je te laisse tester et revenir vers nous

A dispo!

Bonjour Juice,

C'est parfait, je te remercie beaucoup pour ton aide .

Bonne journée à toi!