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

Blad kopieren, waarden plakken, voorwaardelijke opmaak behouden

Status
Niet open voor verdere reacties.

monty1a

Gebruiker
Lid geworden
29 dec 2006
Berichten
202
Hallo,

Ik heb een blad planning waarbij hij in de eerste kolommen A:M diverse info haalt van diverse tabbladen.
De kolommen N:NT bevatten voorwaardelijke opmaak die afhankelijk zijn van A:M

Nu wil ik dmv een macro dit blad kopieren naar een nader te bepalen locatie.
Alleen de formules moeten waardes worden en de voorwaardelijke opmaak moet behouden worden.

IS dit mogelijk dmv VBA?

Alvast bedankt!

MVG Monty
 
Ja. Zonder bestand en verdere info; neem even een macro op dan ben je al een heel eind. Als je er niet uitkomt dan kan je de code even plaatsen en wordt er vast wel iets voor gemaakt/geadviseerd om je verder op weg te helpen.
 
Dit is ff gauw wat ik zou willen

Sub planning()
'
' planning Macro
'

'
Sheets("Planning").Select
ActiveSheet.Buttons.Add(787.5, 3.75, 89.25, 42).Select
Sheets("Planning").Copy
Windows("7216.2 Standaardlijst - mengformulier v2.17 test.xlsm").Activate
Range("A2:M350").Select
Range("M350").Activate
Selection.Copy
Windows("Map6").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
 
Ik zou dus graag een blad willen opslaan als nieuw bestand met alleen de waardes, maar de voorwaardelijke opmaak behouden. Thanx
 
In die code gebeuren een aantal onnodige dingen en ik zie ook je document nog niet als bijlage.
 
Om een kopie van een blad te maken en de VO te behouden kan je zoiets gebruiken.

Code:
Sub VenA()
ar = Workbooks("7216.2 Standaardlijst - mengformulier v2.17 test.xlsm").Sheets(1).Range("A2:M350")
Sheets("Planning").Copy
  With ActiveWorkbook
    .Sheets(1).Range("A2:M350").Value = ar
    .SaveAs ThisWorkbook.Path & "\WeetikVeel" & Format(Now, "yyyy-mm-dd hhmmss")
  End With
End Sub

Dit zal zeer waarschijnlijk niet in 1 keer werken aangezien je nergens aangeeft van waaruit je de code start in welk blad de gegevens staan die gekopieerd moet worden.
 
Ik wil gewoon een knop maken zodat ze dit blad kunnen opslaan. De knop komt waarschijnlijk in het blad "Opdrcheck".
Er hoeft alleen maar het blad "planning" te worden gekopieerd en worden opgeslagen in als nieuw bestand op dezelfde locatie (dit scheelt per bestand namelijk) onder de naam "planning" + de waarde van cel i2 op hetzelfde werkblad.

Ik hoor dat het nu wat duidelijker is...sorry voor het ongemak


Alvast bedankt.
 
Dan lijkt mij de macro-opname niet geheel correct. Plaats het bestandje maar even want de zaken die je nodig hebt staan volgens mij in #7 en zal alleen een beetje aangepast moeten worden.

De knop komt waarschijnlijk in het blad "Opdrcheck".
Klinkt niet echt of je wel weet wat je wil.
 
Ik weet idd niet op welk tabblad ik het een knop wil zetten, ik moet even kijken waar deze knop het makkelijkst is.

Maar de code werkt redelijk correct zoals ik zou willen, alleen...
Als ik het blad "kopieer" dan komt er alleen komt er een verkeerde tekst in te staan, namelijk van een ander tabblad!
Hoe kan ik dit veranderen?

Alvast bedankt voor de eerste stap!

mvg Monty
 
wat er ook mis gaat is als ik mijn bestandsnaam verander.
7216.2 Standaardlijst - mengformulier v2.17 test.xlsm word opgeslagen als : 7216.201 Standaardlijst - mengformulier.xlsm of 7216.202 Standaardlijst - mengformulier.xlsm enz.

Is dit ook te veranderen?
 
Zie oa #2 Maar zolang je alleen maar cryptogrammen blijft plaatsen dan zal je het zelf even moeten bedenken wat je wil. En vervolgens even stapsgewijs uitleggen hoe het proces eruit ziet. En dan ook graag met de bestand(en)? Waarin je dit laat zien:
Als ik het blad "kopieer" dan komt er alleen komt er een verkeerde tekst in te staan, namelijk van een ander tabblad!
 
Ok ik zal duidelijker proberen te zijn.

Ik heb een bestand met veel meer tabbladen waarin we ieder nieuw project in verwerken.
Ieder project krijgt zijn eigen werknummer bijv. 7216.201 enz.
Het bestand is ong 2 mb dus te groot om hier te posten.

Nu heb ik dmv van diverse linken en formules op het blad "planning" een overzicht gemaakt.
Zodra dit project voorbereid is moet het blad "planning" aan onze uitvoerders worden gegeven zodat die daar mee door kunnen gaan, alleen hun hebben dan niets meer aan alle formules en de overige tabbladen. Daarom wil ik dat dit tabblad "planning" met alle waarden word gekopieerd naar een nieuw bestand, alleen wil ik dat de voorwaardelijke opmaak behouden blijft zodat de uitvoering ermee verder kan.
De opslag locatie moet in dezelfde map worden opgeslagen als waar het originele bestand staat opgeslagen.

Ik hoop dat ik nu duidelijker ben.

Ik ben geen held in VBA maar probeer steeds meer te leren van jullie adviezen.

Alvast bedankt.

MVG Monty
 
Het bestand is ong 2 mb dus te groot om hier te posten.

En het is onmogelijk om er een kopie van te maken? Dit zodanig uit te kleden tot je een representatief voorbeeldbestand hebt? 14 posts verder met alleen maar veel tekst en weinig concreets.
 
Heeft een niemand een idee hoe ik een blad kopieer en celwanden plak ipv de formules
 
Code:
Sub VenA()
Sheets("Planning").Copy
With ActiveWorkbook
  .Sheets(1).UsedRange = .Sheets(1).UsedRange.Value
  .SaveAs ThisWorkbook.Path & "\WeetikVeel" & Format(Now, "yyyy-mm-dd hhmmss")
End With
End Sub
 
Dank je wel!

Het is met een paar persoonlijke aanpassing gelukt.


Heb ik nog een andere vraag:

Ik heb 2 tabbladen die ik dmv VBa wil kopiëren naar een andere map

mijn bestand staat op:

C://7216.000/opdr/1. kousformulier
Het eerste nummer (7216.00) veranderd per werk

Als ik nu een gekopieerde blad dmv vba wil opslaan in:
C://7216.000/opdr/2. financieel

Onder de naam "werkbegroting"

Hoe kan ik dit het beste doen?

Alvast bedankt
 
Laatst bewerkt:
Hallo,

Weer een vraag van mij, de vorige heb ik allemaal opgelost.

Ik heb een code gemaakt zodat 3 tabbladen worden gekopieerd als nieuw bestand van het originele bestand.
Alleen in 1 van deze tabbladen zit ook een macro maar die doet het niet als ik hem kopieer met deze code.
Het zal in ieder geval moeten worden opgeslagen als .xlsm (denk ik:shocked:)

Wie kan me helpen?
Code:
Sub Gelijkbenigedriehoek10_Klikken()
  Dim c10 As String, c11 As String
  c10 = ThisWorkbook.Path & "\" & Replace([J35], "\", "") & "\"
  c11 = [J35]
  With CreateObject("Scripting.FileSystemObject")
    If Not .FolderExists(c10) Then .CreateFolder c10
  End With
For Each sh In Sheets(Array("Totalen", "(1)", "Kopieerblad"))
    sh.Visible = True
     Next sh
 Sheets(Array("Totalen", "(1)", "Kopieerblad")).Copy
  With ActiveWorkbook
    .SaveAs c10 & c11 & ".xlsx", 51
  End With
  For Each sh In Sheets(Array("Totalen", "(1)"))
    sh.Visible = False
     Next sh
  ActiveWorkbook.Close
  With ThisWorkbook
          .Sheets(Array("Totalen", "(1)", "Kopieerblad")).Visible = False
End With
 Sheets("Opdrcheck").Select
End Sub
Alvast "WEER" bedankt
 
O ja, dit is de code wat dus moet draaien in het nieuwe bestand!

Code:
Sub VenA()
If MsgBox("U gaat nu de inmeetlijsten aanmaken, mochten dit veel strengen zijn dan kan het enige tijd duren!" & vbCr & vbCr & "Weet u het zeker?", vbOKCancel + vbQuestion, "Let op!") = vbCancel Then Exit Sub
Sheets(" Overzicht").Visible = True
Sheets("(1)").Visible = True
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For Each cl In Sheets("Kopieerblad").Columns(1).SpecialCells(2)
  If cl.Offset(, 2).Value <> 0 Then
    If IsError(Evaluate("'" & cl.Value & "'!A1")) Then
      Sheets("(1)").Copy , Sheets(Sheets.Count)
      With ActiveSheet
        .Name = cl.Value
        .[P2] = cl.Offset(, 3)
      End With
    End If
  End If
Next cl
Application.DisplayAlerts = True
    Sheets("Kopieerblad").Select
      ActiveWindow.SelectedSheets.Visible = False
    Sheets("(1)").Select
      ActiveWindow.SelectedSheets.Visible = False
      Sheets(" Overzicht").Select
End Sub

Thanx to VenA
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan