Subscript valt buiten bereik.

[Ravenlord]

Goedemiddag,

In excel ben ik bezig een facturenprogramma te maken, nu is het zover af alleen moet er nog een klein stukje toegevoegd worden. Namelijk bij het saven van de back up van een rekening moeten er bepaalde waardes gekopieerd worden naar een andere file.
Met onderstaande code krijg ik de foutmelding "Het subscript valt buiten het bereik".
Kan iemand mij helpen dit op te lossen??

Test.xls is de main file, naam.xls is target file

Sub Export()
Workbooks.Open Filename:="I:\Excel\naam.xls"
Windows("naam.xls").Activate
Rows("1:1").Select
Selection.Insert Shift:=xlUp

Windows("Test.xls").Activate
Range("B24").Copy
Windows("naam.xls").Activate
Range("A1").Select
ActiveSheet.Paste

Windows("Test.xls").Activate
Range("B26").Copy
Windows("naam.xls").Activate
Range("B1").Select
ActiveSheet.Paste

Windows("Test.xls").Activate
Range("G37").Copy
Windows("naam.xls").Activate
Range("C1").Select
ActiveSheet.Paste

Windows("Test.xls").Activate
Range("G35").Copy
Windows("naam.xls").Activate
Range("D1").Select
ActiveSheet.Paste

Windows("Test.xls").Activate
Range("G34").Copy
Windows("naam.xls").Activate
Range("E1").Select
ActiveSheet.Paste

ActiveWorkbook.Save

Windows("naam.xls").Activate
ActiveWorkbook.Save
ActiveWindow.Close
End Sub

Alvast heel erg bedankt,

MvG

 

[HSV]

Lukt het hiermee?

Sub Export()
Dim A, B, C, D, E
   Workbooks.Open "I:\Excel\naam.xls"

    Rows("1:1").Insert Shift:=xlUp
With Workbooks("Test.xls").Sheets("Blad1")
   A = .[B24]
   B = .[B26]
   C = .[G37]
   D = .[G35]
   E = .[G34]
  End With

With Sheets("Blad1")
 [A1] = A
 [B1] = B
 [C1] = C
 [D1] = D
 [E1] = E
  End With
 
 Workbooks("naam.xls").Close True
 ActiveWorkbook.Close True

End Sub

 

[Ravenlord]

Perfect, heb het getest en het werkt bedankt.
Nu heb ik echter nog een vraag die in mij opkwam,

Is er een manier in Excel om per kwartaal een andere file te gebruiken voor het exporteren van gegevens. Of is dit beter handmatig te doen ??

 

[HSV]

Dat is wel mogelijk door je bestandsnaam in een cel te zetten waar het naar toe moet worden geschreven.
De code aanpassen en naar die cel verwijzen waar je bestandsnaam staat.

 

[Ravenlord]

Ah oke, dat is eigenlijk logisch,
Is er dan ook een manier om dit automatisch te laten gebeuren op basis van data.

4 cellen met 4 verschillende namen, bijvoorbeeld
A1 Kwartaal 1
A2 Kwartaal 2
A3 Kwartaal 3
A4 Kwartaal 4

En dan in de verschillende kwartalen het juiste bestand te gebruiken ??

 

[HSV]

Klein voorbeeldje.

 

[Ravenlord]

Bedankt, ik ga er mee aan de slag

 

[Ravenlord]

Dit is wat ik er nu uit krijg, nu krijg ik 2 foutmeldingen,
De eerste is weer subscript valt buiten bereik en de andere is een compileer fout.
Waar zit deze fout en hoe los ik deze op ??

Sub Export()
Dim A, B, C, D, E
Workbooks.Open Filename:=ActiveWorkbook.Sheets(Gegevens).Range("B12") & ".xls"

Rows("1:1").Insert Shift:=xlUp
With Workbooks("Test.xls").Sheets("Factuur")
A = .[B24]
B = .[B26]
C = .[G37]
D = .[G35]
E = .[G34]
End With

With Sheets("Blad1")
[A1] = A
[B1] = B
[C1] = C
[D1] = D
[E1] = E
End With

Workbooks Filename:=ActiveWorkbook.Sheets(Gegevens).Range("B12") & ".xls".Close True

End Sub

 

[HSV]

Probeer het zo eens.

Workbooks.Open Filename:=ActiveWorkbook.Sheets(Gegevens).Range("B12")[COLOR="red"].value[/COLOR] & ".xls"

Die ander idem dito.

 

[Ravenlord]

Workbooks Filename:=ActiveWorkbook.Sheets(Gegevens).Range("B12").value & ".xls".Close True

Bij deze zegt het "verwacht instructie einde"

Zou het dan dit moeten worden:

Workbooks.Close Filename:=ActiveWorkbook.Sheets(Gegevens).Range("B12").value & ".xls"

 

[HSV]

Zo moet het ook kunnen volgens mij.

ActiveWorkbook.SaveAs Sheets(Gegevens).Range("B12").value & ".xls" 
ActiveWorkbook.Close

 

[Ravenlord]

Het subscript valt nu weer buiten bereik,

Wat houdt deze melding eigenlijk in ??

 

[HSV]

Dat het bestand of blad niet kan worden gevonden.

ActiveWorkbook.SaveAs Sheets([COLOR="red"]"[/COLOR]Gegevens[COLOR="red"]"[/COLOR]).Range("B12").value & ".xls" 
ActiveWorkbook.Close

Zie de rode dubbele quotes.

 

[Ravenlord]

Dit zou dan moeten kloppen, maar de ene keer krijg ik subscript valt buiten bereik en een andere keer een code 400

Sub Export()
Dim A, B, C, D, E
Workbooks.Open Filename:=ActiveWorkbook.Sheets("Gegevens").Range("B12").Value & ".xls"

Rows("1:1").Insert Shift:=xlUp
With Workbooks("Test.xls").Sheets("Factuur")
A = .[B24]
B = .[B26]
C = .[G37]
D = .[G35]
E = .[G34]
End With

With Sheets("Blad1")
[A1] = A
[B1] = B
[C1] = C
[D1] = D
[E1] = E
End With

ActiveWorkbook.SaveAs Sheets("Gegevens").Range("B12").Value & ".xls"
ActiveWorkbook.Close

End Sub

 

[HSV]

En wat staat er in B12 genoteerd.

 

[Ravenlord]

Pardon, E12,
Daar instaat deze formule =VERT.ZOEKEN(VANDAAG();$A$11:$B$14;2;1)
met als uitkomst Kwartaal 1
Ik heb in dezelfde directory 4 bestanden Kwartaal 1.xls, Kwartaal 2.xls enz.

 

[HSV]

Probeer het zo eens.

Workbooks.Open ThisWorkbook.Path & "\" & Sheets("Gegevens").Range("B12").Value & ".xls"

 

[Ravenlord]

Oke, dat werkt,
Bij het closen moet het natuurlijk ook veranderen,

ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Sheets("Gegevens").Range("E12").Value & ".xls"

Ik dacht zelf dat ThisWorkbook weg zou moeten alleen wat moet er dan voor Path komen ?

 

[HSV]

Zo werkt het niet?

ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Sheets("Gegevens").Range("E12").Value & ".xls"
ActiveWorkbook.close

 

[Ravenlord]

Nee, het opent netjes Kwartaal 1.xls
En daarna komt de melding het subscript valt buiten bereik.