Automatisch volgende cel overnemen

[spoecor]

Hallo,

Ik heb een klein probleem wat mij een hoop tijd kost.

In een bepaald blad maak ik een projectrapportage welke is gekoppeld aan een uniek nummer. Deze worden door een functie automatisch onder het projectnummer opgeslagen.

Echter in een tweede tabblad heb ik een kolom met allemaal projectnummers. Nu moet ik voor ieder project altijd het juiste nummer kopieren om de volgende rapportage te genereren.

Hoe kan ik dit in VBA bijvoorbeeld oplossen dat automatisch alle projecten één voor één in die bepaalde cel geplaatst worden en vervolgens mijn vba script uitvoert en de rapportage opslaat?

Ik ben eenieder zeer dankbaar voor mogelijke oplossingen.....

Groet en dank.
Spoecor

 

[RoCompy87]

Heb je misschien een voorbeeldbestandje?

 

[spoecor]

In het voorbeeld een simpele indeling van de tabbladen. Echter in het echt zijn de formules en zoekwaarde veel ingewikkelder. Het gaat er dus om dat ik met 1 druk op de knop alle 5 de gegevens kan opslaan. De functie opslaan heb ik al in VBA, maar nu nog dat automatisch de 5 projectnr's afloopt. In het voorbeeld zijn deze nummers nummeriek, in werkelijkheid zijn ze alfanummeriek met evt leestekens.

 

[RoCompy87]

Bedoel je zoiets als dit?

Sub opslaan()
Dim c As Range
Dim project

'hier komt de code voor het opslaan van de gegevens

project = Sheets(1).[c1]
Set c = Sheets(3).Columns(1).Find(What:=project, SearchDirection:=xlNext, SearchOrder:=xlByRows)
If c.Offset(1, 0).Value = "" Or c Is Nothing Then Exit Sub Else Sheets(1).[c1] = c.Offset(1, 0).Value
End Sub

Mvg

 

[spoecor]

Sub opslaan()
Dim c As Range
Dim project

Bestandsnaam = "\\Server1\4 Financien\TEMP Projectrapportage\ " & CStr(Range("F2").Value) & ".xls"
ThisWorkbook.SaveAs Bestandsnaam

project = Sheets(rapport).[f2]
Set c = Sheets(projecten).Columns(1).Find(What:=project, SearchDirection:=xlNext, SearchOrder:=xlByRows)
If c.Offset(1, 0).Value = "" Or c Is Nothing Then Exit Sub Else Sheets(rapport).[f2] = c.Offset(1, 0).Value

End Sub

Bovenstaande heb ik nu staan echter ik vraag me af of ik achter sheets(...) wel de naam van het tabblad moet invullen? F2 is de naam van het project.

 

[RoCompy87]

Als je de naam van een sheet gebruikt, dan moet deze tussen haakjes staan. Dus bijvoorbeeld:

Sheets("projecten")

Of was dat niet wat je bedoelde?

 

[spoecor]

Je bent nu al geweldig.

Ik heb nu het volgende staan:

Sub opslaan()
Dim c As Range
Dim project

Bestandsnaam = "c:\budget\rapportage" & CStr(Range("F2").Value) & ".xls"
ThisWorkbook.SaveAs Bestandsnaam

project = Sheets("rapport").[F2]
Set c = Sheets("projecten").Columns(1).Find(What:=project, SearchDirection:=xlNext, SearchOrder:=xlByRows)
If c.Offset(1, 0).Value = "" Or c Is Nothing Then Exit Sub Else Sheets("rapport").[F2] = c.Offset(1, 0).Value

End Sub

Als ik de makro nu uitvoer dan wordt het dus automatisch opgeslagen onder c:\budget\budget met projectnaam.xls

Vervolgens komt inderdaad het volgende project naar voren. Echter dan moet ik de makro weer opnieuw starten om deze weer op te slaan. Kan ik volstaan met nogmaals het opslagpad aan te geven als laatste command?

 

[RoCompy87]

Dus je wilt ze allemaal tegelijk opslaan? Dan werkt dit misschien (niet getest):

Sub opslaan()
Dim i, j as Long

i=Sheets("projecten").Columns(1).Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
For j=1 to i
Sheets("rapport").[F2]=Sheets("projecten").Cells(j,1).value
Bestandsnaam = "c:\budget\rapportage" & CStr(Range("F2").Value) & ".xls"
ThisWorkbook.SaveAs Bestandsnaam
Next j
End Sub

Ik hoor het wel .

 

[Warme bakkertje]

Of

 Sub opslaan()
For j = 1 To WorksheetFunction.CountA(Sheets("projecten").Columns(1))
Sheets("rapport").[F2] = Sheets("projecten").Cells(j, 1).Value
ThisWorkbook.SaveAs "c:\budget\rapportage" & CStr(Range("F2").Value) & ".xls"
Next j
End Sub

 

[spoecor]

Yes, het werkt prima!

De code die ik gebruikt heb is van RoCompy87, hulde....

Ben nu een zeer gelukkig man.

Beankt! :thumb: