detection de cellule vide et copiage

[gildautal]

rebonjour,

un nouveau sujet avec fichier joint
j'ouvre mon fichier1 , je clic sur test qui va m'ouvrir le fichier2, le déproteger, puis me copier dans la feuille "page" mes données.
Seulement là je voudrais qu'un balayage des têtes de tableau (titi,tutu,riri etc...)soit fait pour qu'il ne copie ces données que lorsque il trouvera une entête vide. Dans le cas présent, il les placera après riri.
Est ce qu'un do loop peut faire l'affaire et comment?
merci

 

[Pierrot93]

Re : detection de cellule vide et copiage

Re

regarde le code ci-dessous, si j'ai bien compris, attention il faut déprotéger avant...

Workbooks("Fichier1.xls").Sheets("page1").Range("B2:B28").Copy _
    Workbooks("Fichier2.xls").Sheets("page").Range("IV3").End(xlToLeft).Offset(1, 1)

@+

 

[gildautal]

Re : detection de cellule vide et copiage

merci pour l'aide mais peux tu m'expliquer un peu de quoi il s'agit car je n'ai pas tout compris
merci

 

[Pierrot93]

Re : detection de cellule vide et copiage

Re

copie la plage B2:B28 de la feuille "page1" du classeur "Fichier1", et la colle vers la dernière cellule non vide, avec un décalage d'une ligne et d'une colonne, de la ligne 3 en partant de la fin (cellule IV3) de la feuille "page" du classeur "Fichier2"...

 

[gildautal]

Re : detection de cellule vide et copiage

merci encore et bonnes fetes de fin d'année
cdlt

 

[gildautal]

Re : detection de cellule vide et copiage

bonsoir,
je voudrais amélioré mon fichier11 comme cela ;
Si l'entete (JESSAI) de ce que je veux coller existe dans le fichier22 je colle mes données à cet endroit, sinon je cherche la prochaine entete vide pour y inscrire mon entete et y coller mes données en dessous
Si quelqu'un peut m'aider ce serait sympa
merci

ci joint mes deux fichiers

 

[gildautal]

Re : detection de cellule vide et copiage

bonsoir à tous et joyeuses fêtes de fin d'année

ma dernière question est restée sans réponse car pierrot93 n'est pas là alors est ce qu'en son absence quelqu'un peut m'aider à résoudre mon problème
merci d'avance

 

[Pierrot93]

Re : detection de cellule vide et copiage

Bonjour Gildautal

regarde le code ci dessous, mais attention comme les plages et noms de fichier ont changés...

Option Explicit
Sub test()
Dim x As Range, c As String
c = Workbooks("Fichier11.xls").Sheets("page1").Range("B2").Value
With Workbooks("Fichier22.xls").Sheets("page")
    Set x = .Range("3:3").Find(c, , xlValues, xlWhole, , , False)
    If Not x Is Nothing Then
        Workbooks("Fichier11.xls").Sheets("page1").Range("B5:B31").Copy .Cells(6, x.Column)
    Else
        Workbooks("Fichier11.xls").Sheets("page1").Range("B2:B31").Copy .Range("IV3").End(xlToLeft).Offset(0, 1)
    End If
End With
End Sub

Bonne journée
@+

 

[gildautal]

Re : detection de cellule vide et copiage

bonjour à tous, bonjour pierrot,

merci pour ta réponse qui fonctionne très bien comme d'hab.
j'en apprends tous les jours et c'est passionnant.
bonne journée et bonne fête de fin d'année
encore merci pour ta patience
cordialement

 

[gildautal]

Re : detection de cellule vide et copiage

bonjour pierrot,

j'ai planché sur le sujet et j'ai deux questions :

1) sur "Set x = .Range("3:3").........", je n'ai pas compris ce que signifie "3:3"

2) si j'efface la premiere colonne de mon fichier2, le test ne va pas detecter que cette entete est vide et placera mon entete en "G3".
N'est il pas possible de balayer alors par la gauche à partir de la première colonne. ainsi le test tiendra compte de la première entete vide en partant de la colonne "A" et ceci juqu'a "IV"

ci joint mes deux fichiers corrigés
nota : j'ai volontairement déplacé en page1 le nom "JESSAI"
merci
cdlt

 

[Pierrot93]

Re : detection de cellule vide et copiage

Bonjour Gidautal

Pour ta 1ère question, ".Range("3:3").Find" signifie que la recherche s'effectue sur la ligne 3. Pour ta 2ème question, j'ai modifié le code comme suit. Attention je n'ais pas réouvert les fichiers, si la structure a changée, tu devras adapter le code, mais je pense que maintenant tu as toutes les "billes".

Option Explicit
Sub test()
Dim x As Range, c As String
c = Workbooks("Fichier11.xls").Sheets("page1").Range("B2").Value
With Workbooks("Fichier22.xls").Sheets("page")
    Set x = .Range("3:3").Find(c, , xlValues, xlWhole, , , False)
    If Not x Is Nothing Then
        Workbooks("Fichier11.xls").Sheets("page1").Range("B5:B31").Copy .Cells(6, x.Column)
    Else
        Set x = .Range("3:3").Find("", .Range("IV3"), xlValues, xlWhole, , , False)
        If Not x Is Nothing Then Workbooks("Fichier11.xls").Sheets("page1").Range("B2:B31").Copy x
    End If
End With
End Sub

bonne journée
@+

Edition : Rajouter l'argument "after" dans la 2ème recherche.

 

[gildautal]

detection de cellule vide et copiage suite...

bonjour a tous et bonne année 2009
je reprends près les fetes mon sujet que j'ai essayé d'adapter a mon fichier et la j'ai un message d'erreur (erreur d'exécution 9 l'indice n'ppartient pas à la sélection) sur le :
C = Workbooks("TOTO 88F OP1 26-12-08 232108.xls").Sheets("p1").Range("B3").Value

ci joint la procédure employée et en fait ce nom de fichier évolue a chaque enregistrement et je ne sais comment faire pour qu'il soit reconnu systématiquement et correctement

sub enregistrement()
Application.ScreenUpdating = False
For Each wb In Workbooks
If wb.Name Like "*" & "*" & "*" Then Set wb1 = wb: Exit For
Next wb
If wb1 Is Nothing Then MsgBox "Impossibilité de continuer car le fichier n'est pas ouvert": Exit Sub
wb1.Activate

Sheets("Accueil").Select
Range("B3").Select
Range("B3").Copy
On Error Resume Next
Windows(Dossier_Chefdespe).Activate
Application.ScreenUpdating = False
Sheets("Global").Select
Range("E3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("E6").Select
On Error GoTo 0

For Each wb In Workbooks
If wb.Name Like "*" & "*" & "*" Then Set wb1 = wb: Exit For
Next wb
If wb1 Is Nothing Then MsgBox "Impossibilité de continuer car le fichier n'est pas ouvert": Exit Sub
wb1.Activate

Sheets("p1").Select
Set a1b = Sheets("p1").Range("O12,O15,O18,O21,O24,O27")
Set a2b = Sheets("p1").Range("O42,O45,O48,O51,O54,O57")
Set a3b = Sheets("p1").Range("O72,O75,O78,O81,O84,O87")
Set myMultipleRange = Union(a1b, a2b, a3b)

C = Workbooks("TOTO 88F OP1 26-12-08 232108.xls").Sheets("p1").Range("B3").Value

With Workbooks(Dossier_Chefdespe).Sheets("Global")
Set x = .Range("E3:AR3").Find(C, , xlValues, xlWhole, , , False)
If Not x Is Nothing Then
Sheets("p1").myMultipleRange.Copy .Cells(6, x.Column)
Else
Set x = .Range("E3:AR3").Find("", , xlValues, xlWhole, , , False)
If Not x Is Nothing Then Sheets("p1").myMultipleRange.Copy .Cells(6, x.Column)
If Not x Is Nothing Then Sheets("p1").Range("B3").Copy x
End If
End With

ActiveWorkbook.Save

On Error Resume Next
'lecteurR = Left(Worksheets("admin").range("J3").value, 2)
ChDrive (lecteurR)
cheminRESEAU
'Dossier_reseau = Worksheets("admin").range("J3").value
QPath = Dossier_reseau
' Récupère l'ancien nom du fichier
QFic = Dir(QPath & x & " " & y & " " & Z & " " & "*" & ".xls")
' Le sauvegarde sous le nouveau nom
ActiveWorkbook.SaveAs Dossier_reseau & x & " " & y & " " & Z & " " & Format(Now, "dd-mm-yy hhnnss") & ".xls"
' Supprime l'ancien si existe
If QFic <> "" Then Kill QPath & QFic

If Err.Number <> 0 Then
'lecteurPC = Left(Worksheets("admin").range("K3").value, 2)
ChDrive (lecteurPC)
cheminPC
'Dossier_PCisole = Worksheets("admin").range("K3").value
QPath = Sheets("admin").Range("K3").Value
' Récupère l'ancien nom du fichier
QFic = Dir(QPath & x & " " & y & " " & Z & " " & "*" & ".xls")
' Le sauvegarde sous le nouveau nom

ActiveWorkbook.SaveAs Dossier_PCisole & x & " " & y & " " & Z & " " & Format(Now, "dd-mm-yy hhnnss") & ".xls"
' Supprime l'ancien si existe
If QFic <> "" Then Kill QPath & QFic
End If
On Error GoTo 0
'****************************************************************************************************
Application.DisplayFullScreen = False
Application.DisplayAlerts = False
Application.ScreenUpdating = True
ActiveWindow.Close

End Sub

merci pour votre aide

 

[Pierrot93]

Re : detection de cellule vide et copiage

Bonjour Gildautal,

sans doute le nom du classeur ou le nom de la feuille est erroné... A voir. D'autre part dans ton code, je ne vois aucune déclaration de variable, cela évite bien souvent des erreurs, sans compter que cela améliore la rapidité d'exécution du code...

bonne journée
@+

 

[gildautal]

Re : detection de cellule vide et copiage

bonjour pierrot,

j'ai esayé de modifier ma procédure mais je bute toujours sur la ligne bleue meme avec la déclaration des variables. je ne vois pas comment déclarer mon fichier qui evolue a chaque enregistrement d'une autre manière et surtout je ne suis pas assez fort pour cela. Si tu peux m'aider ce serait avec grand plaisir
merci
cordialement

Sub enregistrement()

Dim VariableAcces As String
Dim x, y, z
Dim a1b, a2b, a3b
Dim Dossier_PCisole, lecteurPC, Dossier_PCChefdespe, Dossier_Chefdespe As String
Dim f as string

lecteurPC = Left(Sheets("admin").Range("K3").Value, 2)
'directory D:
Dossier_PCisole = Sheets("admin").Range("K3").Value
Dossier_PCChefdespe = Sheets("admin").Range("L3").Value
Dossier_Chefdespe = Sheets("admin").Range("N3").Value

x = Sheets("Preface").Range("D43").Value
y = Sheets("Preface").Range("D47").Value
z = Sheets("Preface").Range("D37").Value

'****************************************************************************rive lecteurPC
'ChDrive ("D:")
Workbooks.Open Filename:=Dossier_PCChefdespe

For Each wb In Workbooks
If wb.Name Like "*" & "*" & "*" Then Set wb1 = wb: Exit For
Next wb
If wb1 Is Nothing Then MsgBox "Impossibilité de continuer car le fichier n'est pas ouvert": Exit Sub
wb1.Activate

Sheets("Accueil").Select
Range("B3").Select
Range("B3").Copy
On Error Resume Next
Windows(Dossier_Chefdespe).Activate
Application.ScreenUpdating = False
Sheets("Global").Select
Range("E3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("E6").Select
On Error GoTo 0

For Each wb In Workbooks
If wb.Name Like "*" & "*" & "*" Then Set wb1 = wb: Exit For
Next wb
If wb1 Is Nothing Then MsgBox "Impossibilité de continuer car le fichier n'est pas ouvert": Exit Sub
wb1.Activate

VariableAcces = Sheets("Preface").Cells(45, 6).Value
Windows(Dossier_Chefdespe).Activate

Sheets("Intro").Select
If Cells(20, 4).Value <> VariableAcces Then
MsgBox "L'enregistrement ne s'est pas effectué" & vbCrLf & "car votre fichier n'est pas reconnu" & vbCrLf & "veuillez contacter votre administrateur !"
Exit Sub
End If
'*********************************************************
Application.ScreenUpdating = False
For Each wb In Workbooks
If wb.Name Like "*" & "*" & "*" Then Set wb1 = wb: Exit For
Next wb
If wb1 Is Nothing Then MsgBox "Impossibilité de continuer car le fichier n'est pas ouvert": Exit Sub
wb1.Activate
'*********************************************************
Sheets("p1").Select
Set a1b = Sheets("p1").Range("O12,O15,O18,O21,O24,O27")
Set a2b = Sheets("p1").Range("O42,O45,O48,O51,O54,O57")
Set myMultipleRange = Union(a1b, a2b)
'*********************************************************
lecteurPC
QPath = Dossier_PCisole
QFic = Dir(QPath & x & " " & y & " " & z & " " & "*" & ".xls")
'*********************************************************
f = Workbooks(QFic).Sheets("p1").Range("B3").Value 🙁
With Workbooks(Dossier_Chefdespe).Sheets("Global")
Set x = .Range("E3:AR3").Find(f, , xlValues, xlWhole, , , False)
If Not x Is Nothing Then Workbooks(QFic ).Sheets("p1"). myMultipleRange. Copy .Cells(6, x.Column)
End With

ActiveWorkbook.Save

ChDrive (lecteurPC)
QPath = Dossier_PCisole
QFic = Dir(QPath & x & " " & y & " " & z & " " & "*" & ".xls")
ActiveWorkbook.SaveAs Dossier_PCisole & x & " " & y & " " & z & " " & Format(Now, "dd-mm-yy hhnnss") & ".xls"
If QFic <> "" Then Kill QPath & QFic
'*********************************************************
ActiveWindow.Close

End Sub

 

[Pierrot93]

Re : detection de cellule vide et copiage

Bonjour,

tu me dis que toutes les variables sont déclarées, alors que je ne vois pas "Qfic". Cette variable est elle bien initialisée par le nom d'un classeur ouvert, lorsque tu exécutes ton code pas à pas (utilisation de la touche F8). Sinon difficile de t'en dire plus sans fichier. A noter pour obliger à ce que toutes les variables soient déclarées, mets la ligne de code ci-dessous, sur la première ligne de ton module.

Option Explicit

bonne journée.
@+