grotsblues
XLDnaute Occasionnel
Bonsoir le forum
Je souhaiterai sélectionner une feuille qui commence par "Recap" et copier dans mon fichier recap.xlsm. J'ai trouver un code qui fonctionne très bien mais je souhaiterai l'adapter, et je n'y arrive pas. Quelqu'un peut il m'aider merci pour vos réponse.
Voici mon code
Public CHEMIN As String
Sub consolideXLSX()
Dim classeurMaitre As Workbook
Dim classeurSrc As Workbook
choisirRepertoire
ceclasseur = ThisWorkbook.Name
ChDir ActiveWorkbook.Path
Set classeurMaitre = ActiveWorkbook
nf = Dir("*.xlsx")
Do While nf <> ""
If nf <> classeurMaitre.Name Then
Set classeurSrc = Workbooks.Open(nf) 'OUVRE LE FICHIER
For k = 1 To Sheets.Count
If WorksheetFunction.CountA(classeurSrc.Sheets(k).Cells) <> 0 Then
classeurSrc.Sheets(k).Copy After:=classeurMaitre.Sheets(classeurMaitre.Sheets.Count) 'COPIE SUR LA FEUILLE 2
End If
Next k
classeurSrc.Close False
End If
nf = Dir
Loop
End Sub
Sub choisirRepertoire()
activedir = "C:\"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire pour" & choix, &H1&, activedir)
On Error Resume Next
CHEMIN = objFolder.ParentFolder.ParseName(objFolder.Title).Path
If objFolder.Title = "" Then CHEMIN = ""
x = InStr(objFolder.Title, ":")
If x > 0 Then CHEMIN = Mid(objFolder.Title, x - 1, 2) & ""
If Not Len(CHEMIN) = 0 Then Range(R) = CHEMIN
End Sub
Je souhaiterai sélectionner une feuille qui commence par "Recap" et copier dans mon fichier recap.xlsm. J'ai trouver un code qui fonctionne très bien mais je souhaiterai l'adapter, et je n'y arrive pas. Quelqu'un peut il m'aider merci pour vos réponse.
Voici mon code
Public CHEMIN As String
Sub consolideXLSX()
Dim classeurMaitre As Workbook
Dim classeurSrc As Workbook
choisirRepertoire
ceclasseur = ThisWorkbook.Name
ChDir ActiveWorkbook.Path
Set classeurMaitre = ActiveWorkbook
nf = Dir("*.xlsx")
Do While nf <> ""
If nf <> classeurMaitre.Name Then
Set classeurSrc = Workbooks.Open(nf) 'OUVRE LE FICHIER
For k = 1 To Sheets.Count
If WorksheetFunction.CountA(classeurSrc.Sheets(k).Cells) <> 0 Then
classeurSrc.Sheets(k).Copy After:=classeurMaitre.Sheets(classeurMaitre.Sheets.Count) 'COPIE SUR LA FEUILLE 2
End If
Next k
classeurSrc.Close False
End If
nf = Dir
Loop
End Sub
Sub choisirRepertoire()
activedir = "C:\"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire pour" & choix, &H1&, activedir)
On Error Resume Next
CHEMIN = objFolder.ParentFolder.ParseName(objFolder.Title).Path
If objFolder.Title = "" Then CHEMIN = ""
x = InStr(objFolder.Title, ":")
If x > 0 Then CHEMIN = Mid(objFolder.Title, x - 1, 2) & ""
If Not Len(CHEMIN) = 0 Then Range(R) = CHEMIN
End Sub