excel vba macro sneller laten werken of verbeteren?

[jord]

Beste alle,

Ik wil graag jullie hulp inschakelen, om onderstaand vba beter te maken. D e bedoeling is dat gegevens van de factuur op een volgend blad geboekt worden. De vba werkt maar niet naar wens. Misschien dat jullie tips hebben.

 

Sub Knop35_Klikken()
        Dim Datum, factnr, Relatie As String
        Dim totaal As Double

        Datum = Range("O19").Value
        factnr = Range("O20").Value
        Relatie = Range("O21").Value
     
     If Relatie = "" Then
            MsgBox "Er is geen relatie geselecteerd."
            Exit Sub
        End If
        If Datum = "" Then
            MsgBox "Er is geen datum ingevuld."
            Exit Sub
        End If
        If factnr = "" Then
            MsgBox "Er is geen factuurnumer ingevuld."
            Exit Sub
        End If
        With Worksheets("Verkoop").Range("C7:C10000")
             Set factnr = .Find(Range("O20").Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
             If Not factnr Is Nothing Then
                MsgBox "Er is al een factuur met dit nummer aanwezig!"
                Exit Sub
              End If
        
If IsEmpty(Sheets("verkoopfactuur").Range("O20")) Then
MsgBox "factuurnummer niet ingevuld", vbCritical, "Factuurnummer"
Exit Sub
End If
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Sheets("Verkoopfactuur")
    Set ws2 = Sheets("Verkoop")
    DestRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    ws1.Range("O34:R34").Copy
    ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

    ws1.Range("T34").Copy
    ws2.Cells(Rows.Count, 1).End(xlUp).Offset(0, 5).PasteSpecial xlPasteValues
    
    ws1.Range("V34").Copy
    ws2.Cells(Rows.Count, 1).End(xlUp).Offset(0, 7).PasteSpecial xlPasteValues
    
    ws1.Range("X34").Copy
    ws2.Cells(Rows.Count, 1).End(xlUp).Offset(0, 9).PasteSpecial xlPasteValues
    
    ws1.Range("AA34:AC34").Copy
    ws2.Cells(Rows.Count, 1).End(xlUp).Offset(0, 12).PasteSpecial xlPasteValues
End With

End Sub

 

Gr. Jord

14 december 2018 aangepast door jord

[emielDS]

Als ik het zo lees wil je de factuurgegevens opslaan maar dan zonder datum, factuurnummer en relatiegegevens? En waarom die lege cellen tussenin?

[jord]

Bij deze een proefbestand met "Jan en Kathrien gegevens". Het is de bedoeling dat hij niet de hele regel kopieert, maar dat een volgend tabblad ook door berekeningen kunnen plaatsvinden. Het bestand wijst dat wel uit.

 

Gr. 

proef bestand.xlsm

[emielDS]

bekijk dit eens, ik heb uw BTW berekening ook een beetje veranderd.

proef bestand (1).xlsm

[jord]

Beste Emiel,

 

Uw bestand werkt top. Hoe heeft u dat gedaan. Zie ook dat u het begin stuk heeft veranderd. Vooral dat gedeelte van offset snap ik niet helemaal. Voor de rest werkt deze nu heel soepel en vloeiend. Nogmaals bedankt.

 

Heeft u misschien nog tips om kennis op te doen?

 

gr. Jord

28 december 2018 aangepast door jord

[emielDS]

Veel oefenen en leren van anderen hun opmaak.

 

 With Sheets("verkoop").Range("a10000").End(xlUp)  zoekt de laatst gevulde cel in kolom A
        
        .Offset(1, 0)Value  gaat naar de volgend cel in dezelfde kolom       

        .Offset(1, 5) = [t34]  gaat naar de volgende cel in de kolom  en 5 cellen verder in de rij. en schrijf daar de waarde van cel T34

28 december 2018 aangepast door emielDS

[kweezie wabbit]

@jord

Als je verder geen vragen of problemen meer hebt, geef dan een seintje zodat we dit onderwerp kunnen afsluiten.