mbv vba dezelfde acties uitvoeren in verschillende te openen bestanden

[petmul]

Ik wil in diverse bestanden dezelfde acties uitvoeren.
In het voorbeeld wil ik dus dat je de variabele doorloopt (waarbij de acties voor alle bestanden hetzelfde zijn) tot deze leeg is (van A11 t/m A14)

De bestanden zien er compleet zo uit:
"I:\5 Rapportage\Financiele Rapportage\Tertiaalrapportage\2016\€ Invuldocumenten 2016\B&C\1-DIRECTIE BEDRIJFSV&CONTROL.xlsm"
"I:\5 Rapportage\Financiele Rapportage\Tertiaalrapportage\2016\€ Invuldocumenten 2016\B&C\2-AFD FINANCIEN&CONTROL.xlsm"
"I:\5 Rapportage\Financiele Rapportage\Tertiaalrapportage\2016\€ Invuldocumenten 2016\Bestuur\1-RAAD VAN BESTUUR.xlsm"
"I:\5 Rapportage\Financiele Rapportage\Tertiaalrapportage\2016\€ Invuldocumenten 2016\Bestuur\2-STAFAFD BESTUURSONDERSTEUNING.xlsm"

Dit gedeelte is niet variabel:
I:\5Rapportage\FinancieleRapportage\Tertiaalrapportage\2016\€Invuldocumenten2016\

Dit zijn de variabele gedeelte:
B&C\1-DIRECTIEBEDRIJFSV&CONTROL
B&C\2-AFDFINANCIEN&CONTROL
1-RAADVANBESTUUR.xlsm
Bestuur\2-STAFAFDBESTUURSONDERSTEUNING

Nu heb ik dit zo opgelost maar volgens mij kan het openen van de bestanden dus veel handiger


Workbooks.Open Filename:= _
"I:\5 Rapportage\Financiele Rapportage\Tertiaalrapportage\2016\€ Invuldocumenten 2016\B&C\1-DIRECTIE BEDRIJFSV&CONTROL.xlsm"
ActiveSheet.Unprotect ("Worksheets.Name")
ActiveSheet.Range("$A$4:$C$1068").AutoFilter Field:=2
[X5:X1067].Select
Selection.ClearContents
[Y5].Select
ActiveCell.FormulaR1C1 = "=IF(RC[-24]="""","""",RC[-13]-RC[-9]-RC[-7])"
[Y5].Select
Selection.Copy
[Y6:Y1067].Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWorkbook.Close

Workbooks.Open Filename:= _
"I:\5 Rapportage\Financiele Rapportage\Tertiaalrapportage\2016\€ Invuldocumenten 2016\B&C\2-AFD FINANCIEN&CONTROL.xlsm"
ActiveSheet.Unprotect ("Worksheets.Name")
ActiveSheet.Range("$A$4:$C$1068").AutoFilter Field:=2
[X5:X1067].Select
Selection.ClearContents
[Y5].Select
ActiveCell.FormulaR1C1 = "=IF(RC[-24]="""","""",RC[-13]-RC[-9]-RC[-7])"
[Y5].Select
Selection.Copy
[Y6:Y1067].Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWorkbook.Close

Workbooks.Open Filename:= _
"I:\5 Rapportage\Financiele Rapportage\Tertiaalrapportage\2016\€ Invuldocumenten 2016\Bestuur\1-RAAD VAN BESTUUR.xlsm"
ActiveSheet.Unprotect ("Worksheets.Name")
ActiveSheet.Range("$A$4:$C$1068").AutoFilter Field:=2
[X5:X1067].Select
Selection.ClearContents
[Y5].Select
ActiveCell.FormulaR1C1 = "=IF(RC[-24]="""","""",RC[-13]-RC[-9]-RC[-7])"
[Y5].Select
Selection.Copy
[Y6:Y1067].Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWorkbook.Close

Workbooks.Open Filename:= _
"I:\5 Rapportage\Financiele Rapportage\Tertiaalrapportage\2016\€ Invuldocumenten 2016\Bestuur\2-STAFAFD BESTUURSONDERSTEUNING.xlsm"
ActiveSheet.Unprotect ("Worksheets.Name")
ActiveSheet.Range("$A$4:$C$1068").AutoFilter Field:=2
[X5:X1067].Select
Selection.ClearContents
[Y5].Select
ActiveCell.FormulaR1C1 = "=IF(RC[-24]="""","""",RC[-13]-RC[-9]-RC[-7])"
[Y5].Select
Selection.Copy
[Y6:Y1067].Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWorkbook.Close

 

[VenA]

Plaats code svp tussen codetags.

Probeer het zo eens

Sub VenA()
c00 = "I:\5Rapportage\FinancieleRapportage\Tertiaalrapportage\2016\€Invuldocumenten2016\"
c01 = "B&C\1-DIRECTIEBEDRIJFSV&CONTROL B&C\2-AFDFINANCIEN&CONTROL Bestuur\1-RAAD VAN BESTUUR Bestuur\2-STAFAFDBESTUURSONDERSTEUNING"
For j = 0 To UBound(Split(c01))
  With GetObject(c00 & Split(c01)(j) & ".xlsm")
    With Sheets(1)
      .Unprotect .Name
      .Range("$A$4:$C$1068").AutoFilter 2
      .[X5:X1067].ClearContents
      .[y5].FormulaR1C1 = "=IF(RC[-24]="""","""",RC[-13]-RC[-9]-RC[-7])"
      .[y5].AutoFill .[Y5:Y1067]
    End With
    .Close True
  End With
Next j
End Sub

 

[petmul]

Txs VenA

Ik heb het getest met een iets aangepaste code:
Zie in VBA wel dat de twee bestanden wordt genaderd maar niet dat er wijzigingen worden doorgevoerd.
Dim erbij geplaatst omdat er geen variabele was gedefinieerd.
Wat gaat er niet goed?


Sub VenA()
Dim c00 As String
Dim c01 As String
Dim j As Integer
c00 = "I:\3 Organisatie\Financiele Diensten\Crediteuren\3.04 Crediteuren\TEST"
c01 = "X\Bestand Y\Bestand_2"
For j = 0 To UBound(Split(c01))
With GetObject(c00 & Split(c01)(j) & ".xlsx")
With Sheets(1)
.Unprotect .Name
.[A1:A5].ClearContents
.[C1].FormulaR1C1 = "=IF(RC[3]="""","""",RC[4]-RC[5]-RC[6])"
.[C1].AutoFill .[C1:C5]
End With
.Close True
End With
Next j
End Sub

 

[VenA]

Zonder voorbeeldbestand zou ik het niet weten. Loop met <F8> door de code heen en bekijk stat voor stap wat er gebeurt. Je mist in het pad iig een \

 

[petmul]

Hier de bestanden waarbij Bestand in X staat en Bestand_2 in Y

 

[VenA]

En wat zijn de wachtwoorden?

 

[petmul]

M.b.v. deze macro kan je de beveiliging opheffen en activeren

Sub BeveiligingOpheffenTabblad()
ActiveSheet.Unprotect ("Worksheets.Name")
End Sub
Sub BeveiligenTabblad()
ActiveSheet.Protect ("Worksheets.Name")
End Sub

 

[snb]

Gebruik (ten tweede male !!) code tags rondom VBA-code.

Gebruik in een testfase nooit een vorm van beveiliging (protection)

sub M_snb()
  with Workbooks.Open( "I:\5 Rapportage\Financiele Rapportage\Tertiaalrapportage\2016\€ Invuldocumenten 2016\B&C\1-DIRECTIE BEDRIJFSV&CONTROL.xlsm")
    with .Sheets(1)
       .cells(5,24).resize(1062).ClearContents
      .cells(5,25)= "=IF(B5="""","""",L5-O5-Q5)"
      .cells(5,25).autofilll .cells(5,25).resize(1062)
    end with
    .Close -1
  End With 
End Sub

of

sub M_snb()
  with Workbooks.Open( "I:\5 Rapportage\Financiele Rapportage\Tertiaalrapportage\2016\€ Invuldocumenten 2016\B&C\1-DIRECTIE BEDRIJFSV&CONTROL.xlsm")
    with .Sheets(1).cells(5,24).resize(1062)
      .ClearContents
      .offset(,1)= [IF(B5:B1067="","",L5:L1067-O5:O1067-Q5:Q1067)]
    end with
    .Close -1
  End With 
End Sub

PS. het is niet slim spaties in padnamen op te nemen.
Het is niet slim bijzondere tekens in padnamen/bestandsnamen op te nemen.

 

[VenA]

Bijzonder wachtwoord.

Sub VenA()
Dim c00 As String
Dim c01 As String
Dim j As Integer
c00 = "I:\3 Organisatie\Financiele Diensten\Crediteuren\3.04 Crediteuren\TEST\"
c01 = "Bestand Bestand_2"
For j = 0 To UBound(Split(c01))
  With Workbooks.Open(c00 & Split(c01)(j) & ".xlsx")
    With Sheets(1)
      .Unprotect "Worksheets.Name"
      .[A1:A5].ClearContents
      .[C1].FormulaR1C1 = "=IF(RC[3]="""","""",RC[4]-RC[5]-RC[6])"
      .[C1].AutoFill .[C1:C5]
    End With
    .Close True
  End With
Next j
End Sub

 

[petmul]

Bedankt voor de snelle oplossing en excuses voor de tag code.