Code vereenvoudigen.

Sfinxie · 14 nov 2012

Ik weet niet zeker of ik dit hier mag vragen, maar ik probeer het.
Ik heb ook niet zozeer een probleem, maar meer een vraag om een gunst.
Onderstaande code doet precies wat ik wil, maar is nogal lang en er zitten vrijwel zeker overbodige commando's in.
Bij een ander probleem wat ik hier op het forum al eens gepost heb, is mij gebleken dat het vaak veel mooier en korter kan, waardoor het ook sneller werkt. Ik bezit alleen die kennis niet. Ik laat Excel simpelweg een macro opnemen en verder gaat mijn kennis niet.
Zou iemand zo vriendelijk willen zijn zijn of haar licht er over te laten schijnen?
Alvast enorm bedankt voor de moeite!

PS. Mocht het niet de bedoeling zijn dat dit soort 'luxeprobleempjes' gepost worden dan hoor ik dat graag en zal ik mijn leven beteren.

Code:

Sub Kopieren()
'
' Kopieren Macro
'

'
    Range("C5").Select
    Selection.Copy
    Sheets("Blanco").Select
    Range("C3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Basis routeformulier").Select
    Range("F5:M5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blanco").Select
    Range("F3:M3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Basis routeformulier").Select
    Range("W5:AC5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blanco").Select
    Range("W3:AC3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Basis routeformulier").Select
    Range("B9:D16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blanco").Select
    Range("B9").Select
    Sheets("Basis routeformulier").Select
    Range("B9:B16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blanco").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Basis routeformulier").Select
    Range("C9:D16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blanco").Select
    Range("C9:D9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Basis routeformulier").Select
    Range("E9:F16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blanco").Select
    Range("E9:F9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Basis routeformulier").Select
    Range("G9:I16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blanco").Select
    Range("G9:I9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Basis routeformulier").Select
    Range("J9:N16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blanco").Select
    Range("J9:N9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Basis routeformulier").Select
    Range("O9:Z16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blanco").Select
    Range("O9:Z9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Basis routeformulier").Select
    Range("AA9:AD16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blanco").Select
    Range("AA9:AD9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Basis routeformulier").Select
    Range("AE9:AO16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blanco").Select
    Range("AE9:AO9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=9
    Sheets("Basis routeformulier").Select
    ActiveWindow.SmallScroll Down:=15
    Range("B28:B35").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blanco").Select
    Range("B28").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Basis routeformulier").Select
    Range("C28:D35").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blanco").Select
    Range("C28:D28").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Basis routeformulier").Select
    Range("E28:F35").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blanco").Select
    Range("E28:F28").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Basis routeformulier").Select
    Range("G28:I35").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blanco").Select
    Range("G28:I28").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Basis routeformulier").Select
    Range("J25:AO25").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blanco").Select
    Range("J25").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Basis routeformulier").Select
    Range("J26:AO35").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blanco").Select
    Range("J26").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E36").Select
    Sheets("Blanco").Select
    Application.CutCopyMode = False
    Sheets("Blanco").Copy After:=Sheets(2)
    Sheets("Blanco (2)").Select
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 7
    ActiveWindow.ScrollRow = 6
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 2
    ActiveWindow.ScrollRow = 1
    Sheets("Blanco (2)").Name = "Blanco (2)"
    Range("C3").Select
    Selection.Copy
    Sheets("Blanco (2)").Select
    Sheets("Blanco (2)").Name = Selection
    Range("G22").Select
    ActiveWindow.SmallScroll Down:=-12
    Range("G1:T1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("L6").Select
    Application.CutCopyMode = False
    Sheets("Blanco").Select
    Range("E18").Select
    Sheets("Basis routeformulier").Select
    Range("D26").Select
    ActiveWindow.SmallScroll Down:=-18
End Sub

pasan · 14 nov 2012

het eerste stukje code van jou blok begint met de active sheet C5.select
laat je de macro altijd vanaf deze sheet lopen?
of start je de macro ook vanaf andere sheets? zo ja dan geef de naam van de sheet vanwaar je deze macro opgenomen hebt

Code:

Range("C5").Select
    Selection.Copy
    Sheets("Blanco").Select
    Range("C3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Sfinxie · 14 nov 2012

De macro wordt altijd vanaf dezelfde sheet (blad 1) gestart. Ik heb daar een knop gemaakt die deze macro activeert.
Wat de macro in grote lijnen doet:
Veel gegevens worden vanaf sheet 1 gekopieerd naar sheet 2. Aangezien in sheet 2 nog wat formules staan en ik uiteindelijk een sheet wil hebben zonder formules, wordt ook sheet 2 weer gekopieerd (alleen de waardes) naar een nieuwe sheet en vervolgens krijgt die sheet (sheet 3) de naam van cel C3.

Ter verduidelijking:
blad 1 = "Basis routeformulier"
blad 2 = "Blanco"
blad 3 = 'naam cel C3'

pasan · 14 nov 2012

ik neem aan dat in cel C3 elke keer een andere naam komt. toch?

Sfinxie · 14 nov 2012

Dat klopt. in cel C3, op het derde sheet, komt elke keer een andere naam.
Op het eerste sheet wordt een bepaalde code (routenummer) ingegeven, waarna uit een database alle gegevens van die route worden opgehaald. Met al die gegevens wordt op sheet 2 een zogenaamd routeformulier gegenereerd.
Uiteindelijk moet dat routeformulier, '******proof', dus zonder formules etc., naar chauffeurs gestuurd worden of worden uitgeprint.
Die bepaalde code, routenummer, staat inderdaad in C3 en verschilt dus iedere keer.

pasan · 14 nov 2012

probeer onderstaande code eens
Enigste voorwaarde is dat je de naam van werkblad "Basis routeformulier" moet aanpassen naar "Basis_routeformulier"
er mogen geen spaties in het werkblad naam staan dus ipv een spatie een laag streepje

ik heb letterlijk jou verwijzingen gebruikt omdat ik aanneem dat je niet het hele blad wil kopiëren

Code:

Sub Kopieren()
'
' Kopieren Macro
Dim NewName As String
Dim Sh As Worksheet
  
    [Blanco!C3].Value = [Basis_routeformulier!C5].Value
    [Blanco!F3:M3].Value = [Basis_routeformulier!F5:M5].Value
    [Blanco!W3:AC3].Value = [Basis_routeformulier!W5:AC5].Value
    [Blanco!B9:B16].Value = [Basis_routeformulier!B9:B16].Value
    [Blanco!C9:D16].Value = [Basis_routeformulier!C9:D16].Value
    [Blanco!E9:F16].Value = [Basis_routeformulier!E9:F16].Value
    [Blanco!G9:I16].Value = [Basis_routeformulier!G9:I16].Value
    [Blanco!J9:N16].Value = [Basis_routeformulier!J9:N16].Value
    [Blanco!O9:Z16].Value = [Basis_routeformulier!O9:Z16].Value
    [Blanco!AA9:AD16].Value = [Basis_routeformulier!AA9:AD16].Value
    [Blanco!AE9:AO16].Value = [Basis_routeformulier!AE9:AO16].Value
    [Blanco!B28:B35].Value = [Basis_routeformulier!B28:B35].Value
    [Blanco!C28:D35].Value = [Basis_routeformulier!C28:D35].Value
    [Blanco!E28:F35].Value = [Basis_routeformulier!E28:F35].Value
    [Blanco!G28:I35].Value = [Basis_routeformulier!G28:I35].Value
    [Blanco!J25:AO25].Value = [Basis_routeformulier!J25:AO25].Value
    [Blanco!J26:AO35].Value = [Basis_routeformulier!J26:AO35].Value
        
    
     NewName = [Blanco!C3].Value
DuplicateSearch:
     For Each Sh In Worksheets
       If UCase(Sh.Name) = UCase(NewName) Then
          MsgBox "Er bestaat al een blad met de naam" & " " & NewName: Exit Sub
          NewName = [Blanco!C3].Value
        GoTo DuplicateSearch
       End If
    Next Sh
 [COLOR="#FF0000"] Sheets("Blanco").Copy after:=Sheets(Sheets.Count)[/COLOR]
 ActiveSheet.Name = NewName

End Sub

de kopieer slag heb ik hier http://www.mrexcel.com/forum/excel-questions/49977-copy-worksheet-using-visual-basic-applications.html gevonden

Sfinxie · 14 nov 2012

Blad "Blanco" wordt inderdaad wel gekopieerd naar een derde blad, krijgt ook keurig de juiste naam, maar blijft volledig leeg.
Blad 3 zou een exacte kopie moeten zijn van Blad "Blanco", maar dan zonder formules etc. (en dus die andere naam, maar dat doet ie al goed)

Edit: inmiddels zie ik dat de code is veranderd? Er wordt nu geen derde blad aangemaakt. (Ben ik te haastig? Excuus dan!)

pasan · 14 nov 2012

volgens mij klopt het nu

Sfinxie · 14 nov 2012

Het loopt inderdaad als een speer, maar er gaat toch 1 dingetje fout.
Blad 3 is een kopie van Blad 1 en het moet een kopie van Blad 2 zijn.

pasan · 14 nov 2012

blad 1 = "Basis routeformulier"
blad 2 = "Blanco"
blad 3 = 'naam cel C3

bij mij is blad 3 toch echt een kopie van blad 2

ik kijk nog een keer

pasan · 14 nov 2012

ik had de code getest vanaf blad Blanco en niet van blad1
heb de code aangepast boven zie de rode regel

Sfinxie · 14 nov 2012

Helemaal top!
Tja, mijn kennis van VBA is bij lange niet toereikend voor dit soort dingen. Ik moet me dus altijd behelpen met wat Excel er zelf van maakt als je simpelweg een macro opneemt. Beetje jammer, want ik weet dat 't veel mooier kan (zie jouw code) ik weet alleen niet hoe. Misschien toch maar eens tijd voor een cursus.

In ieder geval hartelijk dank voor je moeite, tijd en inzet!
Topicstatus gaat op 'opgelost'.

snb · 14 nov 2012

dat kan simpeler:

Code:

Sub M_snb()
    sheets("Blanco").range("C3,F3:M3,W3:AC3,B9:B16,C9:D16,E9:F16,G9:I16,J9:N16,O9:Z16,AA9:AD16,AE9:AO16,B28:B35,C28:D35,E28:F35,G28:I35,J25:AO25,J26:AO35")=sheets("Basis_routeformulier").range("C3,F3:M3,W3:AC3,B9:B16,C9:D16,E9:F16,G9:I16,J9:N16,O9:Z16,AA9:AD16,AE9:AO16,B28:B35,C28:D35,E28:F35,G28:I35,J25:AO25,J26:AO35").value

   if not evaluate("isref(" & sheets("blanco").range("C3") & "!A1)") then sheets.add.name=sheets("blanco").range("C3")

End Sub

pasan · 14 nov 2012

bedankt snb dat scheelt weer een paar regels

Sfinxie · 15 nov 2012

Heb ik nog even geprobeerd, maar loopt vast in de laatste regel.
Maar ik ben happy met de code van pasan hoor.
Dank voor het verder meedenken.

pasan · 15 nov 2012

ik heb me er aan gewaagd een paar aanpassingen aan de code van snb te maken om een kopie te verkrijgen van het blad blanco en mocht er al een blad bestaan een melding weer te geven
zoals je ziet is de regel met alle range's opgesplitst door een laag streepje waardoor het 2 aparte regels lijken maar dit is dus 1 regel
heb het alleen maar zo neer gezet om het iets leesbaarder te krijgen

Code:

Sub M_snb()
    Sheets("Blanco").Range("C3,F3:M3,W3:AC3,B9:B16,C9:D16,E9:F16,G9:I16,J9:N16,O9:Z16,AA9:AD16,AE9:AO16,B28:B35,C28:D35,E28:F35,G28:I35,J25:AO25,J26:AO35") _
    = Sheets("Basis_routeformulier").Range("C5,F3:M3,W3:AC3,B9:B16,C9:D16,E9:F16,G9:I16,J9:N16,O9:Z16,AA9:AD16,AE9:AO16,B28:B35,C28:D35,E28:F35,G28:I35,J25:AO25,J26:AO35").Value

   If Not Evaluate("isref(" & Sheets("blanco").Range("C3") & "!A1)") Then Sheets("Blanco").Copy after:=Sheets(Sheets.Count): GoTo doen
   MsgBox "dit blad bestaat al": Exit Sub
  
doen:
   ActiveSheet.Name = Sheets("blanco").Range("C3")

End Sub

snb · 15 nov 2012

Prima, maar geef de gebruiker geen meldingen waar hij/zij niets mee kan.

Sfinxie · 16 nov 2012

Helaas, de foutopsporing blijft dit in geel aangeven: If Not Evaluate("isref(" & Sheets("blanco").Range("C3") & "!A1)") Then
De code uit bericht #6 gaat nog steeds als de brandweer.

pasan · 16 nov 2012

heb je de code uit bericht 16 overgenomen?
en welke fout melding krijg je?

pasan · 16 nov 2012

hier een afbeelding hoe mijn vba editor ingesteld staat onder extra en dan verwijzingen
maar dit is een gok van mijn kant of het hier wel door komt

Code vereenvoudigen.

Gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Terugkerende gebruiker

Gebruiker

Verenigingslid

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Verenigingslid

Gebruiker

Terugkerende gebruiker

Terugkerende gebruiker

Wij waarderen jouw privacy