• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Factuurnummer met 1 verhogen in cel voor meerdere tabbladen

Status
Niet open voor verdere reacties.

lammertje

Gebruiker
Lid geworden
9 nov 2010
Berichten
9
Hallo,

Ik heb een excel bestand met, zeg maar, 200 tabbladen. Op tabblad 1 staat in cel C11 factuurnummer 2011201 vermeld en ik wil het factuurnummer t/m tabblad 200 (waar het nummer eveneens in cel C11 staat) automatisch door laten voeren naar 2011401 (dus zonder telkens het tabblad aan te klikken en het factuurnummer met 1 te verhogen etc.)

Iemand een idee of dit voor elkaar te boksen is?

Alvast bedankt

Lammert
 
Laatst bewerkt:
Code:
Dim iWS As Integer
  For iWS = 2 To 200
     Worksheets(iWS).Range("C11") = Sheets(iWS - 1).Range("C11").Value + 1
  Next
 
Hallo HSV,

Bedankt voor je reactie, ik weet echter niet hoe ik deze code binnen excel kan toepassen.
Er is reeds een VB programma in het bestand werkzaam, wellicht past jou code daar tussen maar ik weet niet waar.
De tekst van het VB programma luidt:

Option Explicit

'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal _
pszpath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) _
As Long

Public Type BrowseInfo
hOwner As Long
pIDLRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Function GetDirectory(Optional msg) As String
On Error Resume Next
Dim bInfo As BrowseInfo
Dim path As String
Dim r As Long, x As Long, pos As Integer

'Root folder = Desktop
bInfo.pIDLRoot = 0&

'Title in the dialog
If IsMissing(msg) Then
bInfo.lpszTitle = "Please select the folder of the excel files to copy."
Else
bInfo.lpszTitle = msg
End If

'Type of directory to return
bInfo.ulFlags = &H1

'Display the dialog
x = SHBrowseForFolder(bInfo)

'Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
On Error Resume Next
WorksheetExists = (Sheets(WorksheetName).Name <> "")
On Error GoTo 0
End Function

Sub CombineFiles()
Dim path As String
Dim FileName As String
Dim LastCell As Range
Dim Wkb As Workbook
Dim WS As Worksheet
Dim ThisWB As String



ThisWB = ThisWorkbook.Name
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
path = GetDirectory
FileName = Dir(path & "\*.xls", vbNormal)

Do Until FileName = ""
If FileName <> ThisWB Then
Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)
For Each WS In Wkb.Worksheets
Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell)
If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then
Else
WS.Name = WS.[E6].Value
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
If WorksheetExists(WS.Name & Chr(32) & "(2)") Then
Sheets(WS.Name).Delete
Sheets(WS.Name & Chr(32) & "(2)").Name = [E6].Value
End If
End If
Next WS
Wkb.Close False
End If
FileName = Dir()
Loop
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With

Set Wkb = Nothing
Set LastCell = Nothing
End Sub

Het VB programma zorgt er voor dat losse excel bestanden in een map geopend worden in een excel bestand als tabbladen. Hoop dat je de code kunt tussenvoegen.

Bedankt al vast
 
Ik zou de code in een nieuwe module stoppen, met op tabblad 1 een knop: en daar de code aanhangen.
De code begint dan bv. met.
Code:
Sub factuurnr()
'hier de code
End sub
 
Hallo HSV,

Wederom bedankt voor je reactie, ik zou echter niet weten hoe ik dit moet doen.
Voor het gemak heb ik een bestand aangemaakt met als titel: voorbeeldbestand voor factuurnummerverhoging.xls, het is de bedoeling dat in blad 2 t/m 10 (deze tabbladen hebben bij mij dus al een naam gekregen) het factuurnummer 2011201 (van blad 1 in cel C11) in de bladen 2 t/m 10 verhoogd wordt met 1 dus voor blad 2 wordt het 2011202, blad 3: 2011203 enz.

Zou het zeer waarderen als je in het bestand een tabblad er bij maakt en hierin een nieuwe module met code plaatst.

BVD

Lammert
 

Bijlagen

Ik had het zo in gedachten Lammert.

Kijk eerst een op de andere bladen, en verzeker je er van dat er niets in cel C11 staat.
Klik op de knop in blad 1 en zie de andere bladen.
Code staat nu op 2 to sheets.count i.p.v. 200.
 

Bijlagen

Hallo Harry,

Verbazingwekkend!! Wat werkt dat goed, nooit geweten dat dit kon.
Ik loop echter nog wel tegen een probleem aan. Wanneer ik blad 1 van jouw bestand kopieeër naar mijn bestand (met zeg maar de 200 tabbladen) en ik geef de opdracht om de facturen te verhogen dan wordt 2011201 veranderd in een 1 terwijl ik natuurlijk graag wil dat er 2011201 blijft staan (en het volgende tabblad 2011202 enz.), bij de andere tabbladen veranderd het factuurnummer eveneens maar dan naar 2 enzovoort.
Heb je hier nog een oplossing voor?
BVD again

Lammert
 
Ik heb geen idee.
Waarom kopiëer je niet alleen de code.

Ps: Heb je die blad wel als 1e blad in rij van alle bladen?
 
Laatst bewerkt:
Harry,

Het lag aan een opdracht in het tabblad dat zich in mijn bestand bevond en dat zich als tabblad voor jouw bewerking bevond. Na deze te hebben verwijderd werkt het geweldig.
Hartelijk dank voor je medewerking!!!
 
Lammert,

Graag gedaan; mag ik je vragen het als opgelost te zetten.
Bvd.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan