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

In een andere map Opslaan

Status
Niet open voor verdere reacties.
Jack Nouws

Jack Nouws

Terugkerende gebruiker
Lid geworden
16 apr 2008
Berichten
1.396
Code: 
Sub CmdPartijOpslaanV_Klikken()
Dim c                   As Range
Dim legeregel           As Integer

ActiveSheet.Unprotect

Application.ScreenUpdating = False
  For Each c In Sheets("VerkoopOrder").Range("E21:E42")
    If c <> "" Then
        legeregel = Sheets(c.Value).Range("S65536").End(xlUp).Row + 1
        Sheets(c.Value).Range("N" & legeregel).Resize(1, 13).Interior.Color = RGB(243, 229, 235)
        Sheets(c.Value).Range("N" & legeregel).Resize(1, 13).Borders.LineStyle = xlContinuous
        Sheets(c.Value).Range("N" & legeregel) = Sheets("VerkoopOrder").Range("N14")
        Sheets(c.Value).Range("O" & legeregel) = Sheets("VerkoopOrder").Range("C" & c.Row)
        Sheets(c.Value).Range("P" & legeregel) = Sheets("VerkoopOrder").Range("D" & c.Row)
        Sheets(c.Value).Range("S" & legeregel) = Sheets("VerkoopOrder").Range("E" & c.Row)
        Sheets(c.Value).Range("T" & legeregel) = Sheets("VerkoopOrder").Range("L" & c.Row)
        Sheets(c.Value).Range("U" & legeregel) = Sheets("VerkoopOrder").Range("D13")
        Sheets(c.Value).Range("V" & legeregel) = Sheets("VerkoopOrder").Range("E13")
        Sheets(c.Value).Range("W" & legeregel) = Sheets("VerkoopOrder").Range("E14")
        Sheets(c.Value).Range("X" & legeregel) = Sheets("VerkoopOrder").Range("G14")
        Sheets(c.Value).Range("Y" & legeregel) = Sheets("VerkoopOrder").Range("E15")
        Sheets(c.Value).Range("Z" & legeregel) = Sheets("VerkoopOrder").Range("F15")
        'plaats hier de regels van al de andere gegevens welke je over wil zetten
    End If
Next c

Application.ScreenUpdating = True
    Opslaan_NuV
End Sub

Deze code werkt uitstekend maar nu wil ik hebben dat het in een ander bestand wordt geplaatst (Voorraad). Hoe kan ik dat het beste doen?

Met vr gr Jack
 
Jack Nouws zei:
Code: 
Sub CmdPartijOpslaanV_Klikken()
Dim c                   As Range
Dim legeregel           As Integer

ActiveSheet.Unprotect

Application.ScreenUpdating = False
  For Each c In Sheets("VerkoopOrder").Range("E21:E42")
    If c <> "" Then
        legeregel = MyRange.Sheets(c.Value).Range("S65536").End(xlUp).Row + 1
        Sheets(c.Value).Range("N" & legeregel).Resize(1, 13).Interior.Color = RGB(243, 229, 235)
        Sheets(c.Value).Range("N" & legeregel).Resize(1, 13).Borders.LineStyle = xlContinuous
        Sheets(c.Value).Range("N" & legeregel) = Sheets("VerkoopOrder").Range("N14")
        Sheets(c.Value).Range("O" & legeregel) = Sheets("VerkoopOrder").Range("C" & c.Row)
        Sheets(c.Value).Range("P" & legeregel) = Sheets("VerkoopOrder").Range("D" & c.Row)
        Sheets(c.Value).Range("S" & legeregel) = Sheets("VerkoopOrder").Range("E" & c.Row)
        Sheets(c.Value).Range("T" & legeregel) = Sheets("VerkoopOrder").Range("L" & c.Row)
        Sheets(c.Value).Range("U" & legeregel) = Sheets("VerkoopOrder").Range("D13")
        Sheets(c.Value).Range("V" & legeregel) = Sheets("VerkoopOrder").Range("E13")
        Sheets(c.Value).Range("W" & legeregel) = Sheets("VerkoopOrder").Range("E14")
        Sheets(c.Value).Range("X" & legeregel) = Sheets("VerkoopOrder").Range("G14")
        Sheets(c.Value).Range("Y" & legeregel) = Sheets("VerkoopOrder").Range("E15")
        Sheets(c.Value).Range("Z" & legeregel) = Sheets("VerkoopOrder").Range("F15")
        'plaats hier de regels van al de andere gegevens welke je over wil zetten
    End If
Next c

Application.ScreenUpdating = True
    Opslaan_NuV
End Sub

Deze code werkt uitstekend maar nu wil ik hebben dat het in een ander bestand wordt geplaatst (Voorraad). Hoe kan ik dat het beste doen?

Met vr gr Jack
Klik om te vergroten...

Tot hier lukt het nog wel maar dan ...
Code: 
[COLOR="Blue"]Sub CmdPartijOpslaanV_Klikken()
Dim MyRange             As Variant
Dim c                   As Range
Dim legeregel           As Integer

ActiveSheet.Unprotect
Set MyRange = Workbooks("Voorraad")
Application.ScreenUpdating = False

For Each c In Sheets("VerkoopOrder").Range("E21:E42")
    If c <> "" Then
        legeregel = MyRange.Sheets(c.Value).Range("S65536").End(xlUp).Row + 1[/COLOR]
        Sheets(c.Value).Range("N" & legeregel).Resize(1, 13).Interior.Color = RGB(243, 229, 235)
        Sheets(c.Value).Range("N" & legeregel).Resize(1, 13).Borders.LineStyle = xlContinuous
        Sheets(c.Value).Range("N" & legeregel) = Sheets("VerkoopOrder").Range("N14")
 
Laatst bewerkt:
Als het bestand Voorraad reeds geopend is, dan kan je rechtstreeks wegschrijven.
Zo iets:
Code: 
Workbook("Voorraad").Worksheets(c.value).Range(

enz.

Met vriendelijke groet,


Roncancio
 
Roncancio zei:
Als het bestand Voorraad reeds geopend is, dan kan je rechtstreeks wegschrijven.
Zo iets:
Code: 
Workbook("Voorraad").Worksheets(c.value).Range(

enz.

Met vriendelijke groet,


Roncancio
Klik om te vergroten...

Waarom werkt het dan nog niet?
Code: 
Sub CmdPartijOpslaanV_Klikken()
Dim MyRange             As Variant
Dim c                        As Range
Dim legeregel           As Integer

ActiveSheet.Unprotect
Application.ScreenUpdating = False
Set MyRange = Workbooks("Voorraad")

For Each c In Sheets("VerkoopOrder").Range("E21:E42")
    If c <> "" Then
        legeregel = Workbooks("Voorraad").Sheets(c.Value).Range("S65536").End(xlUp).Row + 1
     [COLOR="Red"]   Workbooks("Voorraad").Sheets(c.Value).Range("N" & legeregel).Resize(1, 13).Interior.Color = RGB(243, 229, 235)[/COLOR]
 
mmm, kan het er aan liggen dat je je MyRange nog niet heb gedefinieerd.
Nu weet hij niet waarvan de laatste regel, deze blijft dus leeg.
 
Demeter zei:
mmm, kan het er aan liggen dat je je MyRange nog niet heb gedefinieerd.
Nu weet hij niet waarvan de laatste regel, deze blijft dus leeg.
Klik om te vergroten...

Hoe zou je deze het beste kunnen defineren dan?
Met vr gr Jack
 
Demeter zei:
mmm, kan het er aan liggen dat je je MyRange nog niet heb gedefinieerd.
Nu weet hij niet waarvan de laatste regel, deze blijft dus leeg.
Klik om te vergroten...

Nope, dat maakt niet uit om dat MyRange niet in die code gebruikt wordt.
Dit werkt gewoon:
Code: 
Sub CmdPartijOpslaanV_Klikken()
Dim MyRange             As Variant
Dim c                        As Range
Dim legeregel           As Integer

ActiveSheet.Unprotect
Application.ScreenUpdating = False

For Each c In Sheets("VerkoopOrder").Range("E21:E42")
    If c <> "" Then
        legeregel = Workbooks("Voorraad").Sheets(c.Value).Range("S65536").End(xlUp).Row + 1
        Workbooks("Voorraad").Sheets(c.Value).Range("N" & legeregel).Resize(1, 13).Interior.Color = RGB(243, 229, 235)
    End If
Next
End Sub

Met vriendelijke groet,


Roncancio


Met vriendelijke groet,


Roncancio
 
Roncancio zei:
Nope, dat maakt niet uit om dat MyRange niet in die code gebruikt wordt.
Dit werkt gewoon:
Code: 
Sub CmdPartijOpslaanV_Klikken()
Dim MyRange             As Variant
Dim c                        As Range
Dim legeregel           As Integer

ActiveSheet.Unprotect
Application.ScreenUpdating = False

For Each c In Sheets("VerkoopOrder").Range("E21:E42")
    If c <> "" Then
        legeregel = Workbooks("Voorraad").Sheets(c.Value).Range("S65536").End(xlUp).Row + 1
        Workbooks("Voorraad").Sheets(c.Value).Range("N" & legeregel).Resize(1, 13).Interior.Color = RGB(243, 229, 235)
    End If
Next
End Sub

Met vriendelijke groet,


Roncancio


Met vriendelijke groet,


Roncancio
Klik om te vergroten...
Als er kolommen verborgen zijn dan werkt het niet heb ik de indruk. Klopt dat?


Mer vr gr
Jack
 
Roncancio zei:
Nee, dat klopt niet.
Het werkt gewoon.

Met vriendelijke groet,


Roncancio
Klik om te vergroten...

Hebbes Ik heb deze regel er nog aan toegevoegd
Code: 
        Workbooks("Voorraad").Sheets(c.Value).Unprotect
En nu werkt het als een speer.
Bedankt roncancio:thumb:
Met vr gr Jack
 
Jack Nouws zei:
Hebbes Ik heb deze regel er nog aan toegevoegd
Code: 
        Workbooks("Voorraad").Sheets(c.Value).Unprotect
En nu werkt het als een speer.
Bedankt roncancio:thumb:
Met vr gr Jack
Klik om te vergroten...

Graag gedaan.
Gaarne de vraag op opgelost zetten (rechts onderaan het scherm).
Bvd.

Met vriendelijke groet,


Roncancio
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan