Bonjour,
J’ai besoin d’aide SVP
A partir d’un fichier de base j’active une macro qui me permet d’ouvrir des fichiers excel dans un dossier, de me copier une plage de cellule et de les coller sur mon fichier de base seulement les fichiers excel a ouvrir dans mon dossier contiennent un userform qui s’ouvre a l’ouverture du fichier et qui bloque la macro car je ne sais pas comment fermer cette userform pour copier mes cellules
En plus clair voici la macro du fichier de base
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
r = MsgBox("Vous confirmez l'intégration des CA ? ", vbYesNo + vbQuestion, "INTEGRATION DES CA")
If r = vbYes Then
With ActiveWorkbook
End With
Dim W As String
i = 1
W = Dir("C:\Documents and Settings\Tony\Bureau\CA\*.xls")
Do Until W = ""
i = i + 1
Workbooks.Open Filename:="C:\Documents and Settings\Tony\Bureau\CA\" & W
If i = 150 Or i = 153 Then i = i + 2
'le nom
ActiveWorkbook.Sheets(1).Range("C3:C8").Select
Selection.Copy
Windows("SYNTHESE").Activate
Sheets("RETOUR").Select
Cells(4, i).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(4, i).Validation.Delete
Cells(5, i).Validation.Delete
Cells(6, i).Validation.Delete
Cells(7, i).Validation.Delete
Cells(8, i).Validation.Delete
Cells(9, i).Validation.Delete
Application.Windows(2).Activate
ActiveWorkbook.Close SaveChanges:=False
W = Dir
Loop
Application.Goto Sheets(1).Range("A1")
End If
Sheets("TABLEAU").Select
Range("F3").Select
Range("F2").Select
Application.ScreenUpdating = True
End Sub
Et celle des fichiers excel
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayFullScreen = False
With ActiveWindow
.DisplayHorizontalScrollBar = True
.DisplayVerticalScrollBar = True
End With
Dim vbext_pk_Proc As Long
Dim debut As Integer
Dim nblignes As Integer
On Error Resume Next
With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
debut = .ProcStartLine("Workbook_Open", vbext_pk_Proc)
nblignes = .ProcCountLines("Workbook_Open", vbext_pk_Proc)
.DeleteLines debut, nblignes
End With
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=(Range("N1"))
Application.DisplayAlerts = True
End Sub
Private Sub Workbook_Open()
Application.DisplayFullScreen = True
With ActiveWindow
End With
Application.WindowState = xlMaximized
UserForm1.Show
Sheets("TONY").ScrollArea = "A1:G14"
End Sub
Merci d’avance de votre aide
Cdt
Tony
J’ai besoin d’aide SVP
A partir d’un fichier de base j’active une macro qui me permet d’ouvrir des fichiers excel dans un dossier, de me copier une plage de cellule et de les coller sur mon fichier de base seulement les fichiers excel a ouvrir dans mon dossier contiennent un userform qui s’ouvre a l’ouverture du fichier et qui bloque la macro car je ne sais pas comment fermer cette userform pour copier mes cellules
En plus clair voici la macro du fichier de base
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
r = MsgBox("Vous confirmez l'intégration des CA ? ", vbYesNo + vbQuestion, "INTEGRATION DES CA")
If r = vbYes Then
With ActiveWorkbook
End With
Dim W As String
i = 1
W = Dir("C:\Documents and Settings\Tony\Bureau\CA\*.xls")
Do Until W = ""
i = i + 1
Workbooks.Open Filename:="C:\Documents and Settings\Tony\Bureau\CA\" & W
If i = 150 Or i = 153 Then i = i + 2
'le nom
ActiveWorkbook.Sheets(1).Range("C3:C8").Select
Selection.Copy
Windows("SYNTHESE").Activate
Sheets("RETOUR").Select
Cells(4, i).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(4, i).Validation.Delete
Cells(5, i).Validation.Delete
Cells(6, i).Validation.Delete
Cells(7, i).Validation.Delete
Cells(8, i).Validation.Delete
Cells(9, i).Validation.Delete
Application.Windows(2).Activate
ActiveWorkbook.Close SaveChanges:=False
W = Dir
Loop
Application.Goto Sheets(1).Range("A1")
End If
Sheets("TABLEAU").Select
Range("F3").Select
Range("F2").Select
Application.ScreenUpdating = True
End Sub
Et celle des fichiers excel
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayFullScreen = False
With ActiveWindow
.DisplayHorizontalScrollBar = True
.DisplayVerticalScrollBar = True
End With
Dim vbext_pk_Proc As Long
Dim debut As Integer
Dim nblignes As Integer
On Error Resume Next
With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
debut = .ProcStartLine("Workbook_Open", vbext_pk_Proc)
nblignes = .ProcCountLines("Workbook_Open", vbext_pk_Proc)
.DeleteLines debut, nblignes
End With
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=(Range("N1"))
Application.DisplayAlerts = True
End Sub
Private Sub Workbook_Open()
Application.DisplayFullScreen = True
With ActiveWindow
End With
Application.WindowState = xlMaximized
UserForm1.Show
Sheets("TONY").ScrollArea = "A1:G14"
End Sub
Merci d’avance de votre aide
Cdt
Tony