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

 

[gildautal]

Re : detection de cellule vide et copiage

bonjour pierrot,

j'ai suivi tes conseils en vain et je tourne en rond sans savoir ce qui cloche.
je ne peux t'envoyer les 2 fichiers car ils sont trop lourds par contre voilà ou j'en suis à savoir que ca cloche toujours au meme endroit (en bleu)
(erreur 9 & l'indice n'appartient pas à la selection)
désolé mais là je demande vraiment ton aide
merci

Option Explicit
Public fichier As Object
Public afh, afv, afo, aff, afg, aft, afb, afs, affo, b_outil() As Boolean
Public i As Integer
Public c As Integer
Dim myMultipleRange As Range
Dim QPath, Qfic As String

Dim g As Range
Dim w As String
Dim wb As Workbook, wb1 As Workbook
Dim wc As Workbook, wc2 As Workbook
Dim Qpafic, Dossier_PCisole, Dossier_reseau, Dossier_resadmin, Dossier_PCadmin, lecteurPC, lecteurR, Dossier_PCChefdespe, Dossier_Chefdespe, Dossier_resChefdespe As String

Sub enregistrement()

Dim VariableAcces As String
Dim x, y, z
Dim a1, a2, a3, a4, a5, a6
Dim Dossier_PCisole, lecteurPC, Dossier_PCChefdespe, Dossier_Chefdespe As String

lecteurPC = Left(Sheets("admin").Range("K3").Value, 2)
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

ChDrive lecteurPC
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

Windows(Dossier_Chefdespe).Activate

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 a1 = Sheets("p1").Range("O11,O14,O17,O20,O23,O26")
Set a2 = Sheets("p1").Range("O41,O44,O47,O50,O53,O56")
Set a3 = Sheets("p1").Range("O71,O74,O77,O80,O83,O86")
Set a4 = Sheets("p1").Range("O101,O104,O107,O110,O113,O116")
Set a5 = Sheets("p1").Range("O131,O134,O137,O140,O143,O146")
Set a6 = Sheets("p1").Range("O161,O164,O167,O170,O173,O176")

Set myMultipleRange = Union(a1, a2, a3, a4, a5, a6)
'myMultipleRange.Copy

QPath = Dossier_PCisole
Qfic = QPath & x & " " & y & " " & z & " " & "*" & ".xls"

w = Workbooks(Qfic).Sheets("Preface").Range("F45").ValueWith Workbooks(Dossier_Chefdespe).Sheets("Global")
Set g = .Range("E3:AR3").Find(w, , xlValues, xlWhole, , , False)
If Not g Is Nothing Then
Workbooks(Qfic).Sheets("p1").myMultipleRange.Copy .Cells(6, x.Column)
Else
Set g = .Range("E3:AR3").Find("", , xlValues, xlWhole, , , False)
If Not g Is Nothing Then Workbooks("Fichier1.xls").Sheets("p1").Range("E3:AR3").Copy .Cells(6, x.Column)
If Not g Is Nothing Then Workbooks("Fichier1.xls").Sheets("Accueil").Range("B3").Copy g
End If
End With

ActiveWorkbook.Save

ChDrive (lecteurPC)
cheminPC
QPath = Sheets("admin").Range("K3").Value
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
Sub sortie()

Application.Quit

End Sub

 

[Pierrot93]

Re : detection de cellule vide et copiage

Bonjour gidautal,

as tu exécuté ton code pas à pas (touche F8 dans l'éditeur vba) et vérifié que la variable "QFIC" était bien initialisée par le nom d'un classeur ouvert ? Et sur ce même classeur, une feuille nommée "Preface" était bien présente (nom au caractère près, même accentuation, même casse) ?

Sans pouvoir tester, difficile pour moi de t'en dire plus.

bonne journée.
@+

 

[gildautal]

Re : detection de cellule vide et copiage

bonjour pierre,

hier je me suis couché avec un mal de tete et ce matin tombé du lit.
ca me mine de ne pas comprendre.
effectivement j'ai utilisé F8 pas a pas et lorsque j'arrive a mon problème eh bien si je passse la souris a coté de Qfic il reconnais bien le chemin dédié par contre il ne passe pas cette ligne là w= ..............
je suis dans l'impasse. il y a surement un problème de variable mais laquelle (x peut etre je ne vois pas )
Pour toi il n'y a pas d'anomalie dans la procédure ?
cordialement

 

[Pierrot93]

Re : detection de cellule vide et copiage

Re

le nom de la feuille est bien le bon ? La cellule F45 de cette même feuille est renseignée par quoi ? Est elle fusionnée ?

@+

 

[gildautal]

Re : detection de cellule vide et copiage

bonsoir pierrot,

Enfin j'ai trouvé et non sans mal.
j'avais oublié le Dir dans :
QPath = Dossier_PCisole
Qfic = Dir(QPath & x & " " & y & " " & z & " " & "*" & ".xls")

voilà @+ et encore merci pour ton aide

cordialement