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

Range kopiëren naar nieuw tabblad

Status
Niet open voor verdere reacties.
W

wieter

Terugkerende gebruiker
Lid geworden
26 jun 2009
Berichten
1.128
Met onderstaande code, kopieer ik een RANGE naar een nieuw tabblad.
De rode regel in de code bepaalt de RANGE die gekopieerd moet worden.
Op het nieuwe blad verschijnt echter de Range A3:K20 i.p.v. Range A3:O20
Code: 
Private Sub CommandButton2_Click()
'aanmaak nieuw tabblad mat als naam (maand + jaar)
 tabnaam = Format([B3].Value, "mmmm yy")
For Each Sheet In ThisWorkbook.Sheets
If Sheet.Name = tabnaam Then bestaatal = True: Exit For
    Next Sheet
If bestaatal = True Then
        MsgBox "Het tabblad " & tabnaam & " bestaat al!"
Else
Application.ScreenUpdating = False
    Worksheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = tabnaam
        [COLOR="#FF0000"]Sheets("Blad1").Range("A3:O20").Copy[/COLOR]
With Sheets(tabnaam).Range("A1")
  .PasteSpecial xlPasteValues
  .PasteSpecial xlPasteColumnWidths
  .PasteSpecial xlPasteFormats
  .Range("A1").Select
End With
Application.ScreenUpdating = True
Sheets("Blad1").Select
    Range("B5:O20").ClearContents
    Range("B5").Select
End If
End Sub
Wat is er mis aan de code?
 

Bijlagen

  • Koen.xlsm
    31,7 KB · Weergaven: 36
Ik heb ondertussen ontdekt dat het te maken heeft met de Voorw.opmaak, die op Blad1, vanaf Kolom L van toepassing is.
Die voorw.opmaak, zou bij het kopiëren moeten uitgeschakeld worden.
Hoe????
 
Het probleem is opgelost, door de 2 eerste regels(die eigenlijk overbodig zijn), mee te kopiëren.
 
De code is goed. Het word wel gekopieerd maar er wordt een voorwaardelijke opmaak toegepast die niet meer klopt
die vergelijkt met waarde met cel $D$2. maar na het kopiëren van het tabblad bevat D2 heel andere waarde dan op het sjabloon blad

Met een paar flinke aanpassingen in de formules in de sheet en VO lukte het uiteindelijk wel.

Bekijk bijlage Kopie van Koen-2.xlsm



edit: reacties gemist tussen het ontbijten en lezen door :)
maar inderdaad het eenvoudigst is de rij 1 en 2 mee te kopiëren.
 
Laatst bewerkt:
Ik zou hiervoor een userform gebruiken.

Maar anders:
Voorkom dat een knop ingedrukt kan worden die niet van toepassing is.

Code: 
Private Sub Worksheet_Activate()
  On Error Resume Next
  x0 = Sheets(Format(Cells(3, 2), "mmmm yy")).Cells(1)
  CommandButton2.Visible = Err.Number <> 0
End Sub

Private Sub CommandButton2_Click()
  Application.EnableEvents = False
  ActiveSheet.Copy , Sheets(Sheets.Count)
  Application.EnableEvents = True
    
  Sheets(Sheets.Count).Name = Format(Cells(3, 2), "mmmm yy")
  UsedRange.Value = UsedRange.Value
  Shapes.SelectAll
  Selection.Delete
  Blad1.UsedRange.Replace "x", "", 1
  Application.Goto Blad1.Cells(2, 4)
End Sub
 
Laatst bewerkt:
@Roel
De formule die je gebruikt, had ik ook al toegepast.
Maar die klopt niet voor alle maanden.
In 2017 klopt ze niet voor de maanden "mei" en "juli".

Knap gevonden, die voorwaardelijke opmaak!!!!!
 
Laatst bewerkt:
Je kan er ook voor kiezen om de usedrange te kopiëren en daarna de eerste twee rijen en de vw-opmaak te verwijderen.
Code: 
Private Sub CommandButton2_Click()
'aanmaak nieuw tabblad mat als naam (maand + jaar)
tabnaam = Format([B3].Value, "mmmm yy")
If Not IsError(Evaluate("'" & tabnaam & "'!A1")) Then
       MsgBox "Het tabblad " & tabnaam & " bestaat al!"
Else
Application.ScreenUpdating = False
   Sheets.Add(, Sheets(Sheets.Count)).Name = tabnaam
  Sheets("Blad1").UsedRange.Copy
With Sheets(tabnaam).Range("A1")
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteColumnWidths
    .PasteSpecial xlPasteFormats
    .Parent.UsedRange.FormatConditions.Delete
    .Parent.Rows(1).Resize(2).Delete
 End With
 With Sheets("Blad1")
    .Range("B5:O20").ClearContents
    Application.Goto .Range("B5")
 End With
End If
End Sub
 
@SNB
Fijn, op die code kan ik me weer eens uitleven!
 
Knap Harry, bedankt.
Nu heb ik zelfs de keuze.
 
Ik heb het tonen van de datums anders aangepakt.
i.p.v. met voorw.opmaak te werken(voorstel van VenA), heb ik de formules aangepast met een extra voorwaarde(nl. "Laatste.dag").

Bij het opslaan van een maand verwijder ik eerst de V.O. voor de zaterdagen.
Code: 
With Sheets(tabnaam).Range("A1")
  .PasteSpecial xlPasteValues
  .PasteSpecial xlPasteColumnWidths
  .PasteSpecial xlPasteFormats
  [COLOR="#FF0000"].Parent.UsedRange.FormatConditions.Delete[/COLOR]
  .Range("A1").Select
End With
Dan bepaal ik in de opgeslagen maand een nieuwe V.O. voor de zaterdagen, met onderstaande code:
Code: 
With Sheets(tabnaam)
    .Range("B1:O18").FormatConditions.Add Type:=xlExpression, Formula1:="=WEEKDAG(B$1;2)=6"
    .Range("B1:O18").FormatConditions(1).Interior.ColorIndex = 36
    .Protect "123"
    .EnableSelection = xlNoSelection
End With
Ik vroeg me af, of die 2 eerste regels niet kunnen samen gevoegd worden?
De vraag is opgelost, met een With-routine.
 

Bijlagen

  • Koen2.xlsm
    35,7 KB · Weergaven: 25
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan