• 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.

cel naam als tabnaam maken

Status
Niet open voor verdere reacties.
Jack Nouws

Jack Nouws

Terugkerende gebruiker
Lid geworden
16 apr 2008
Berichten
1.396
Hallo

Is het mogelijk wanneer je een naam in een cel in typt, dat er dan gelijk een nieuw blad wordt aangemaakt met de tabnaam van die cel?

met vr gr
Jack
 
Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Range("a1")) Is Nothing Then
    Worksheets.Add AFTER:=Worksheets(Worksheets.Count)
    Worksheets(Worksheets.Count).Name = Target.Value
End If
End Sub

Bovenstaande code moet je in ThisWorkbook plaatsen en werkt alleen voor cel A1 (is wel aan te passen) omdat je anders wel erg veel werkbladen erbij krijgt. :p:p

Met vriendelijke groet,


Roncancio
 
Roncancio zei:
Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Range("a1")) Is Nothing Then
    Worksheets.Add AFTER:=Worksheets(Worksheets.Count)
    Worksheets(Worksheets.Count).Name = Target.Value
End If
End Sub

Bovenstaande code moet je in ThisWorkbook plaatsen en werkt alleen voor cel A1 (is wel aan te passen) omdat je anders wel erg veel werkbladen erbij krijgt. :p:p

Met vriendelijke groet,


Roncancio
Klik om te vergroten...

Bedankt, maar wat ik eigenlijk bedoel is het volgende: er worden in mijn blad, namen in kolom C onder elkaar geplaatst en het is de bedoeling dat wanneer er een naam bij wordt geplaatst er automatisch een nieuw tabblad wordt aangemaakt met de betreffende naam.
Hopelijk heb je zo een beter beeld van wat ik bedoel.

Met vr gr
Jack
 
Ik hoop het!
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C:C")) Is Nothing Then
    Worksheets.Add AFTER:=Worksheets(Worksheets.Count)
    Worksheets(Worksheets.Count).Name = Target.Value
End If

End Sub
Wijzig je je iets in de C-kolom dan wordt er een nieuw blad aangemaakt met als naam de wijziging.
De code is voor 1 werkblad. (Ik vermoed dat je het voor 1 werkblad wilt hebben).

Met vriendelijke groet,


Roncancio
 
Roncancio zei:
Ik hoop het!
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C:C")) Is Nothing Then
    Worksheets.Add AFTER:=Worksheets(Worksheets.Count)
    Worksheets(Worksheets.Count).Name = Target.Value
End If

End Sub

Roncancio
Klik om te vergroten...

Wijzig je je iets in de C-kolom dan wordt er een nieuw blad aangemaakt met als naam de wijziging.
De code is voor 1 werkblad. (Ik vermoed dat je het voor 1 werkblad wilt hebben).

Met vriendelijke groet,
De code is idd voor 1 werkblad. Nog een vraagje, zou je er ook een bepaalde opmaak mee kunnen geven zoals: Cel kleuren, kolombreedtes en rijhoogtes?(dus opmaak voor het nieuwe blad)

Met vr gr
Jack
 
Jack Nouws zei:
Wijzig je je iets in de C-kolom dan wordt er een nieuw blad aangemaakt met als naam de wijziging.
De code is voor 1 werkblad. (Ik vermoed dat je het voor 1 werkblad wilt hebben).

Met vriendelijke groet,
De code is idd voor 1 werkblad. Nog een vraagje, zou je er ook een bepaalde opmaak mee kunnen geven zoals: Cel kleuren, kolombreedtes en rijhoogtes?(dus opmaak voor het nieuwe blad)

Met vr gr
Jack
Klik om te vergroten...

Ik neem aan dat je de opmaak van een ander blad wilt gebruiken.

Met vriendelijke groet,


Roncancio
 
Roncancio zei:
Ik neem aan dat je de opmaak van een ander blad wilt gebruiken.

Met vriendelijke groet,


Roncancio
Klik om te vergroten...

Ja, dat klopt. En is het ook mogelijk om dit nieuwe blad in een ander bestaand bestand te laten plaatsen?
 
Laatst bewerkt:
Jack Nouws zei:
Ja, dat klopt. En is het ook mogelijk om dit nieuwe blad in een ander bestaand bestand te laten plaatsen?
Klik om te vergroten...

Tuurlijk, tuurlijk.:cool:
In zowel het huidige bestand als het andere bestand?

Met vriendelijke groet,


Roncancio
 
Roncancio zei:
Tuurlijk, tuurlijk.:cool:
In zowel het huidige bestand als het andere bestand?

Met vriendelijke groet,


Roncancio
Klik om te vergroten...

Wat ik bedoel is: het nieuwe aangemaakte tabblad zou in een ander bestand terecht moeten komen, met daarbij die aangepaste opmaak. Is dat mogelijk? Dus niet in het huidige bestand!

Met vr gr
Jack
 
Laatst bewerkt:
Jack Nouws zei:
Wat ik bedoel is: het nieuwe aangemaakte tabblad zou in een ander bestand terecht moeten komen, met daarbij die aangepaste opmaak. Is dat mogelijk? Dus niet in het huidige bestand!

Met vr gr
Jack
Klik om te vergroten...

Ja dat kan zeker.
Is het steeds hetzelfde bestand waarnaar geschreven moet worden?

Met vriendelijke groet,


Roncancio
 
Naar eer en geweten..
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C:C")) Is Nothing Then
    ActiveSheet.Cells.Copy
    Workbooks.Open "C:\Voorraad.xls"
    Workbooks("Voorraad").Worksheets.Add AFTER:=Worksheets(Worksheets.Count)
    Workbooks("Voorraad").Worksheets(Worksheets.Count).Name = Target.Value
    Workbooks("Voorraad").Worksheets(Worksheets.Count).Range("A1").PasteSpecial Paste:=xlPasteFormats
    Workbooks("Voorraad").Close savechanges:=True
    Application.CutCopyMode = xlCut
End If

End Sub

Met vriendelijke groet,


Roncancio
 
Roncancio zei:
Naar eer en geweten..
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C:C")) Is Nothing Then
    ActiveSheet.Cells.Copy
    Workbooks.Open "C:\Voorraad.xls"
    Workbooks("Voorraad").Worksheets.Add AFTER:=Worksheets(Worksheets.Count)
    Workbooks("Voorraad").Worksheets(Worksheets.Count).Name = Target.Value
    Workbooks("Voorraad").Worksheets(Worksheets.Count).Range("A1").PasteSpecial Paste:=xlPasteFormats
    Workbooks("Voorraad").Close savechanges:=True
    Application.CutCopyMode = xlCut
End If

End Sub

Met vriendelijke groet,


Roncancio
Klik om te vergroten...

Gaaf Joh:cool::thumb:
En om alle cellen met inhoud over te brengen, is dat ook nog mogelijk?
en om geplaatste knoppen (op het blad) over te brengen, is dat ook mogelijk?

Met vr gr
Jack
 
Onderstaande code kopieert het gehele werkblad naar het bestand Voorraad.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C:C")) Is Nothing Then
    Workbooks.Open "C:\Voorraad.xls"
    ThisWorkbook.ActiveSheet.Copy Before:=Workbooks("Voorraad").Worksheets(Worksheets.Count)
    Workbooks("Voorraad").Worksheets(Worksheets.Count).Name = Target.Value
    Workbooks("Voorraad").Close savechanges:=True
    Application.CutCopyMode = xlCut
End Sub

Met vriendelijke groet,


Roncancio
 
Roncancio zei:
Onderstaande code kopieert het gehele werkblad naar het bestand Voorraad.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C:C")) Is Nothing Then
    Workbooks.Open "C:\Voorraad.xls"
    ThisWorkbook.ActiveSheet.Copy Before:=Workbooks("Voorraad").Worksheets(Worksheets.Count)
    Workbooks("Voorraad").Worksheets(Worksheets.Count).Name = Target.Value
    Workbooks("Voorraad").Close savechanges:=True
    Application.CutCopyMode = xlCut
End Sub

Met vriendelijke groet,


Roncancio
Klik om te vergroten...

Beste Roncancio,

Zou je het nog een keertje over willen doen maar dan met onderstaande code.
(Dus cellen met inhoud en het behoud van de toegevoegde knoppen op het blad)
Zoals je ziet heb ik een kleine aanpassing gedaan voor het te kopieeren bestand dit komt uit bestand Voorraad en blad Abies alba!

Met vr gr
Jack

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C:C")) Is Nothing Then
'    ActiveSheet.Cells.Copy
    Workbooks.Open "C:\Documents and Settings\Jack Nouws\Mijn documenten\Voorraad.xls"
    Worksheets("Abies alba").Cells.Copy
    Workbooks("Voorraad").Worksheets.Add AFTER:=Worksheets(Worksheets.Count)
    Workbooks("Voorraad").Worksheets(Worksheets.Count).Name = Target.Value
    Workbooks("Voorraad").Worksheets(Worksheets.Count).Range("A1").PasteSpecial Paste:=xlPasteFormats
    Workbooks("Voorraad").Close savechanges:=True
    Application.CutCopyMode = xlCut
End If
End Sub
 
Laatst bewerkt:
Volgens mij moet het zo goed zijn.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C:C")) Is Nothing Then
    Workbooks.Open "C:\Documents and Settings\Jack Nouws\Mijn documenten\Voorraad.xls"
    ThisWorkbook.Worksheets("Abies alba").Copy Before:=Workbooks("Voorraad").Worksheets(Worksheets.Count)
    Workbooks("Voorraad").Worksheets(Worksheets.Count).Name = Target.Value
    Workbooks("Voorraad").Close savechanges:=True
    Application.CutCopyMode = xlCut
End If
End Sub

Met vriendelijke groet,


Roncancio
 
Roncancio zei:
Volgens mij moet het zo goed zijn.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C:C")) Is Nothing Then
    Workbooks.Open "C:\Documents and Settings\Jack Nouws\Mijn documenten\Voorraad.xls"
    ThisWorkbook.Worksheets("Abies alba").Copy Before:=Workbooks("Voorraad").Worksheets(Worksheets.Count)
    Workbooks("Voorraad").Worksheets(Worksheets.Count).Name = Target.Value
    Workbooks("Voorraad").Close savechanges:=True
    Application.CutCopyMode = xlCut
End If
End Sub

Met vriendelijke groet,


Roncancio
Klik om te vergroten...

Nu krijg ik een fout op deze regel

Code: 
    ThisWorkbook.Worksheets("Abies alba").Copy Before:=Workbooks("Voorraad").Worksheets(Worksheets.Count)

Met vr gr
Jack
 
Bij mij werkt het zonder problemen.

Welke melding krijg je?
Kan het zijn dat VBA de naam van het werkblad (abies alba) niet kan vinden?

Met vriendelijke groet,


Roncancio
 
Roncancio zei:
Bij mij werkt het zonder problemen.

Welke melding krijg je?
Kan het zijn dat VBA de naam van het werkblad (abies alba) niet kan vinden?

Met vriendelijke groet,


Roncancio
Klik om te vergroten...

euh ja ik krijg die regel in het geel te zien tja ik weet er ook niet zoveel vanaf maar in ieder geval bij deze code doet tie het wel maar dan krijg ik m'n knoppen niet geplaatst en die wou ik er juist wel bij hebben.:confused: Ik weet niet of hier nog wat aan te passen valt om die knoppen er bij te plaatsen?

Met vr gr
Jack

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Target, Range("C:C")) Is Nothing Then
         Workbooks.Open "C:\Documents and Settings\Jack Nouws\Mijn documenten\Voorraad.xls"
        Worksheets("Abies alba").Range("A1:AC30").Copy
        Workbooks("Voorraad").Worksheets.Add AFTER:=Worksheets(Worksheets.Count)
        Workbooks("Voorraad").Worksheets(Worksheets.Count).Name = Target.Value
   With Workbooks("Voorraad").Worksheets(Worksheets.Count).Range("A1")
           .PasteSpecial xlPasteValues
           .PasteSpecial xlPasteColumnWidths
           .PasteSpecial xlPasteFormats
    End With
    Workbooks("Voorraad").Close savechanges:=True
    Application.CutCopyMode = xlCut
End If
Application.ScreenUpdating = True
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan