Werkblad kopieren van bv 2008 naar 2009

[Joost V]

Geachte forumers,

Via een collega ben ik op de hoogte gebracht van deze site.
Ikzelf ben totaal niet bedreven in het schrijven van macro's maar wil toch een vraag plaatsen.
Ik wil graag de tabbladen waarvan de naam bestaad uit naam + jaartal volledig kopieren naar een nieuw tabblad (dezelfde) naam + jaartal (een jaar verder dus van 2008 naar 2009).
Verder zouden er gegevens gewist moeten worden (cel D1 t/m H15) en de inhoud van cel D5 gekopieerd moeten worden naar A1. Ik weet dat ik waarschijnlijk veel vraag, maar is er iemand die mij op weg zou kunnen helpen?
O ja, de opmaak van het blad moet ook gekopieerd worden.
Bij voorbaad dank.
Joost V.

 

[Wigi]

Hoi

En waarom doe je dat dan niet manueel? Tegen de tijd dat je de macro geschreven hebt kan je al veel tabbladen kopiëren en hernoemen.

Je kan eenzelfde actie (bvb. een aantal cellen leegmaken) zelfs onmiddellijk op meerdere tabbladen doen door die tabbladen vooraf te selecteren via de Shift toets, en dan de actie 1 keer te doen.

Wigi

 

[Joost V]

Beste Wigi,

Ik zou het wel handmatig kunnen doen maar automatisch vind ik leuker.
Ik heb bovendien even gezocht en kwam het volgende tegen, iets wat jij gepost had voor iemand anders.

Sub tabbladenKopieren()

    Dim ws As Worksheet
    Dim wsNieuwBlad As Worksheet
    
    'lus doorheen tabbladen
    For Each ws In ThisWorkbook.Worksheets
    
        'neem enkel bladen met het huidige jaar in de naam
        If InStr(ws.Name, Year(date)) > 0 Then
            
            'voeg nieuw blad toe
            Set wsNieuwBlad = Worksheets.Add(after:=Sheets(Worksheets.Count))
            
            'verander de naam van toegevoegde blad
            wsNieuwBlad.Name = Replace(ws.Name, Year(date), Year(date) + 1)
            
            'kopieer gegevens
            
            'mag je zelf nog doen ;-)
            
        End If
    
    Next ws

End Sub

Deze code voegt van de huidige werkbladen een nieuwe toe maar dan een jaar verder. Hier kan ik al wat mee. Zou je mij ook op weg kunnen helpen met het kopieren van de werkbladen 2008 in die van 2009?
Er zijn 73 medewerkers

Joost V.

 

[Joost V]

Hallo allemaal,

Allereerst prettige kerstdagen gewenst en een voorspoedig 2009.
Wat is eigenlijk de beste volgorde om het kopieren e.d. te doen.
Moet je eerst het oude blad kopieren, wijzigen en dan herbenoemen of eerst nieuw blad, kopieren en tot slot wijzigen. Ik ben een hoop aan het lezen en zoeken om deze macro tot stand te krijgen, maar ik ben er nog lang niet klaar mee.
Weet iemand een goed boek waar ik mee uit de voeten kan?

Groeten Joost V.

 

[Hoornvan]

Joost V,

Dit heb ik van een ander forum afgehaald (Office Forum) misschien heb je er wat aan.

Om een kopie van het laatste werkblad achter het laatste werkblad te zetten:

with workbooks(1) 
  .sheets(.sheets.count).copy ,.sheets(sheets.count) 
end with

Jij ook nog de beste wensen voor 2009

 

[Wigi]

Sub tabbladenKopieren()

    Dim ws As Worksheet
    Dim wsNieuwBlad As Worksheet
    
    With ThisWorkbook
    
        'lus doorheen tabbladen
        For Each ws In .Worksheets
        
            'neem enkel bladen met het huidige jaar in de naam
            If InStr(ws.Name, Year(Date)) > 0 Then
                
                'kopieer blad
                ws.Copy after:=.Sheets(.Sheets.Count)
                
                'wijs toe aan variabele
                Set wsNieuwBlad = .Sheets(.Sheets.Count)
                
                'verander de naam van toegevoegde blad
                wsNieuwBlad.Name = Replace(ws.Name, Year(Date), Year(Date) + 1)
                
            End If
        
        Next ws
        
    End With
    
    Set ws = Nothing
    Set wsNieuwBlad = Nothing

End Sub

Eindelijk nog 's iemand die de zoekfunctie gebruikt, bedankt.

Wigi

 

[Joost V]

Wigi,

Nogmaals bedankt, ik heb de code nog wat aangepast voor het wissen en kopieren van gegevens en wil hem nog verder bewerken met wat beveiligingen en MsgBoxen.
Zie hieronder het resultaat tot zover.

Sub tabbladenKopieren()

    Dim ws As Worksheet
    Dim wsNieuwBlad As Worksheet

    'Controle datum na 31 dec en voor 10 jan
    'Moet nog

    With ThisWorkbook
    
        'lus doorheen tabbladen
        For Each ws In .Worksheets
        
            'neem enkel bladen met het huidige jaar in de naam
            If InStr(ws.Name, Year(Date)) > 0 Then
                
                'kopieer blad en wis inhoud
                ws.Copy after:=.Sheets(.Sheets.Count)
                Range("F7").Select
                Selection.Copy
                Range("C4").Select
                Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
                     False, Transpose:=False
                Range("B9:C32,E9:F28,F4,C6,F6").Select
                Selection.ClearContents
                Range("C1:D1").Select
                
                'Vul gegevens via textbox (2x) in
                'Moet nog

                'wijs toe aan variabel
                Set wsNieuwBlad = .Sheets(.Sheets.Count)
                
                'verander de naam van toegevoegde blad
                wsNieuwBlad.Name = Replace(ws.Name, Year(Date), Year(Date) + 1)
                
            End If
        
        Next ws
        
    End With
    
    Set ws = Nothing
    Set wsNieuwBlad = Nothing

End Sub

Vriendelijke groeten Joost V.

 

[Wigi]

Ik denk dat je het principe van de variabele ws nog niet door hebt.

Zie aanpassingen:

Sub tabbladenKopieren()

    Dim ws As Worksheet
    Dim wsNieuwBlad As Worksheet

    'Controle datum na 31 dec en voor 10 jan
    'Moet nog

    With ThisWorkbook
    
        'lus doorheen tabbladen
        For Each ws In .Worksheets
        
            'neem enkel bladen met het huidige jaar in de naam
            If InStr(ws.Name, Year(Date)) > 0 Then
                
                'kopieer blad en wis inhoud
                ws.Copy after:=.Sheets(.Sheets.Count)
                
                'wijs toe aan variabel
                [B]Set wsNieuwBlad = .Sheets(.Sheets.Count)[/B]
                
                [B]ws[/B].Range("C4").Value = [B]ws[/B].Range("F7").Value
                [B]ws[/B].Range("B9:C32,E9:F28,F4,C6,F6").ClearContents
                
                'Vul gegevens via textbox (2x) in
                'Moet nog
                
                'verander de naam van toegevoegde blad
                wsNieuwBlad.Name = Replace(ws.Name, Year(Date), Year(Date) + 1)
                
            End If
        
        Next ws
        
    End With
    
    Set ws = Nothing
    Set wsNieuwBlad = Nothing

End Sub

Tevens kunnen al die Select's eruit.

Wigi

 

[Joost V]

Hallo Wigi,

Ik begin het te begrijpen geloof ik, al zit er bij jouw volgens mij een foutje in.
In jouw geval wordt het werkblad van 2008 na kopieren leeg gemaakt terwijl na het kopieren werblad 2009 leeg gemaakt moet worden. Volgens mij moet het dan zo.

Sub tabbladenKopieren()

    Dim ws As Worksheet
    Dim wsNieuwBlad As Worksheet

    'Controle datum na 31 dec en voor 10 jan
    If (Month(Date) = 12 And Day(date)=31) Or (Month(Date) = 1 And Day(Date) = 10) Then
    Goto Line1
    Else: MsgBox "Huidige datum valt buiten 31 December en 10 Januarie!", vbInformation, "Datum buiten berijk."
   Exit Sub

    With ThisWorkbook
    
        'lus doorheen tabbladen
        For Each ws In .Worksheets
        
            'neem enkel bladen met het huidige jaar in de naam
            If InStr(ws.Name, Year(Date)) > 0 Then
                
                'kopieer blad en wis inhoud
                ws.Copy after:=.Sheets(.Sheets.Count)
                
                'wijs toe aan variabel
                Set wsNieuwBlad = .Sheets(.Sheets.Count)
                
                ws[B]NieuwBlad[/B].Range("C4").Value = ws[B]NieuwBlad[/B].Range("F7").Value
                ws[B]NieuwBlad[/B].Range("B9:C32,E9:F28,F4,C6,F6").ClearContents
                [B]wsNieuwblad.Range("C1:D1").Select[/B]
                
                'Vul gegevens via textbox (6x) in
                'Moet nog
                
                'verander de naam van toegevoegde blad
                wsNieuwBlad.Name = Replace(ws.Name, Year(Date), Year(Date) + 1)
                
            End If
        
        Next ws
    End If
    
    End With

Tevens heb ik dankzij u de msgbox geplaatst bovenaan in de code. Daarvoor nogmaals dank.:thumb: Ik moet nu nog gegevens automatisch invullen via bv een textbox. Is dat alleen mogelijk via een userform met textboxen of kan dat ook via een msgbox met textboxen.
Ik ga er nog even mee stoeien, al kan ik nog niets vinden over een combinatie van msgbox met textbox.

Groeten Joost V.

 

[Wigi]

Volgens mij moet het dan zo. ...

Inderdaad. Alleen lijkt die laatste regel met Select mij niet nodig, tenzij je effectief de cursor wil verplaatsen.

Wigi

 

[Wigi]

Ik ga er nog even mee stoeien, al kan ik nog niets vinden over een combinatie van msgbox met textbox.

Een Inputbox.