Application.cutcopymode = false

[stefano]

In een macro worden data gekopieerd en geplakt. Ik stel vast dat die data op het klembord actief zijn/blijven. Ik gebruik nochthans hier en daar application.cutcopymode : false

Waarom wordt het klembord niet gewist?

- macro 1

Sub macro_vandaag()
    Call HM2("TOV", "Tarweontvangsten vandaag")
End Sub

-macro 2

Sub HM2(FN As String, NFN As String)
    Dim rijen As Integer

' 1. indien eindbestand open staat, afsluiten
    Dim Wb As Workbook
    On Error Resume Next
    Set Wb = Workbooks(NFN & ".xlsm")
    If Err.Number = 0 Then
        MsgBox "Bestand " & Wb.Name & " staat nog open, dit wordt afgesloten zonder opslaan"
        Wb.Close
    End If
' 1. einde afsluiten

    Application.DisplayAlerts = False
    Workbooks.OpenText Filename:="C:\data\sap\" & FN & "_1" & ".xls"
    Cells.Copy
    Application.Goto [A1]
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("Y:IV").Select
    Selection.NumberFormat = "0.000"
    Application.Goto [A1]
    Application.Run "RIJENSAMENVOEGEN"
    Workbooks.Open Filename:="C:\data\sap\" & FN & "_2" & ".xlsm"
    Workbooks(FN & "_2" & ".xlsm").Activate
    rijen = Cells(Rows.Count, 1).End(xlUp).Row
    Rows("8" & ":" & rijen).Copy
    Range("A8").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Application.Goto [A1]
    Workbooks(FN & "_2" & ".xlsm").SaveAs "C:\data\sap\" & NFN
    Workbooks(FN & "_1" & ".xls").Close False
    Application.DisplayAlerts = True
End Sub

in bovenstaande code wordt een derde macro opgeroepen (rijensamenvoegen)

Sub RIJENSAMENVOEGEN()
' error inbouwen wanneer er nog geen ontvangsten zijn
On Error GoTo Err1:
Dim i As Long, x As Long
Dim ii As Integer
Dim T1 As Variant
Const lSC As Long = 2  'regelnummer van de startcel
    T1 = Cells(lSC, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row - (lSC - 1), 256)
    ReDim T2(1 To 256, 1 To 1)
    For i = 1 To 256
        T2(i, 1) = T1(1, i)
    Next i
    x = 1
    For i = 2 To UBound(T1, 1)
        If T1(i, 1) = T1(i - 1, 1) Then
            For ii = 1 To 256
                If Replace(T1(i, ii), " ", "") <> "" Then T2(ii, x) = T1(i, ii)
            Next ii
        Else
            x = x + 1
            ReDim Preserve T2(1 To 256, 1 To x)
            For ii = 1 To 256
                T2(ii, x) = T1(i, ii)
            Next ii
        End If
    Next i
    With Sheets.Add(after:=Sheets(ActiveSheet.Index))
        With .Previous
            .Range("A1:IV1").Copy Cells(1, 1)
            .Cells.Copy
        End With
        .Cells.PasteSpecial xlPasteFormats
        .Cells(2, 1).Resize(UBound(T2, 2), 256) = WorksheetFunction.Transpose(T2)
        .Cells(1, 1).Select
    End With
    Application.CutCopyMode = False
Err1:
End Sub

[edmoor]

Met Application.CutCopyMode = False wis je inderdaad niet de kopie buffer.
Die opdracht zet alleen de selectie in het document uit.

Zie ook:
https://docs.microsoft.com/en-us/off...on.cutcopymode

[HSV]

Er zijn andere manieren om data om te zetten in waarden.

Waarom open je een .xls met de OpenText methode?

[stefano]

@hsv Ik krijg die zo aangeboden vanuit een extern programma. En neen, ik ben geen kenner he . Het is eigenlijk een .txt met een .xls bestandsnaam.

@Ed, ik mag dus niet alles geloven wat men op internet neerpent . Dit commando maakt dus enkel het selecteren ongedaan ...

Verder lees ik dat het gebruik van het clipboard beter zou vermijden ...

kan ik dan onderstaand door iets vervangen zonder clipboard te gebruiken?

    Cells.Copy
    Application.Goto [A1]
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

[edmoor]

Het zal echt een gewoon Excel bestand zijn en geen platte tekst, anders kan je er nooit met VBA Excel objecten er op los en vallen er geen formules te verwijderen.
Dat is namelijk wat je code doet.
Er is niks mis met het gebruik van het Clipboard, het enige waarvoor men dat roept is omdat het geheugenruimte in beslag neemt.
Wat je code betreft bereik je hetzelfde met dit:

ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value

Met Cells.Copy gebruik je het adres $1:$1048576
En dat neemt inderdaad nogal wat ruimte in het geheugen in beslag.
Met mijn voorbeeld gebeurt dat niet.

[stefano]

Code vervangen, dit werkt , alhoewel het nu merkelijk trager gaat (max 5 sec).

dank !

[edmoor]

Dat lijkt me vreemd, maar goed, als je het zo in orde vind is dat prima uiteraard.

[edmoor]

Je hebt toch niet alleen Application.CutCopyMode = False vervangen door ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value hoop ik?

[stefano]

Ik heb er dit van gemaakt:

Sub HM2(FN As String, NFN As String) ' macro voor een plan met meerdere operaties (rijen samenvoegen)
    Dim rijen As Integer
' 1. indien eindbestand open staat, afsluiten
    Dim Wb As Workbook
    On Error Resume Next
    Set Wb = Workbooks(NFN & ".xlsm")
    If Err.Number = 0 Then
        MsgBox "Bestand " & Wb.Name & " staat nog open, dit wordt afgesloten zonder opslaan"
        Wb.Close
    End If
' 1. einde afsluiten
    Application.DisplayAlerts = False
    Workbooks.OpenText Filename:="C:\data\sap\" & FN & "_1" & ".xls"
'    Cells.Copy
'    Application.Goto [A1]
'    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'        :=False, Transpose:=False
'    Application.CutCopyMode = False
    ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
'    Columns("Y:IV").Select
'    Selection.NumberFormat = "0.000"
    Columns("Y:IV").NumberFormat = "0.000"
'    Application.Goto [A1]
    Application.Run "RIJENSAMENVOEGEN"
    Workbooks.Open Filename:="C:\data\sap\" & FN & "_2" & ".xlsm"
    Workbooks(FN & "_2" & ".xlsm").Activate
    rijen = Cells(Rows.Count, 1).End(xlUp).Row
    Rows("8" & ":" & rijen).Copy
    Range("A8").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Application.Goto [A1]
    Workbooks(FN & "_2" & ".xlsm").SaveAs "C:\data\sap\" & NFN
    Workbooks(FN & "_1" & ".xls").Close False
    Application.DisplayAlerts = True
End Sub

[edmoor]

Voor zover ik kan zien is die regel, en dus ook je eerdere stukje code, daar volledig overbodig.
Je opent daar een tekst bestand en dus zijn er geen formules die moeten worden omgezet naar waarden.
Daarnaast doe je iets verderop exact hetzelfde dat ook vervangen kan worden door een equivalent zonder .Copy

[stefano]

ik weet niet hoe ik het kan vervangen . Kan je helpen?

Sub HM2(FN As String, NFN As String) ' macro voor een plan met meerdere operaties (rijen samenvoegen)
    Dim rijen As Integer
' 1. indien eindbestand open staat, afsluiten
    Dim Wb As Workbook
    On Error Resume Next
    Set Wb = Workbooks(NFN & ".xlsm")
    If Err.Number = 0 Then
        MsgBox "Bestand " & Wb.Name & " staat nog open, dit wordt afgesloten zonder opslaan"
        Wb.Close
    End If
' 1. einde afsluiten
    Application.DisplayAlerts = False
    Workbooks.OpenText Filename:="C:\data\sap\" & FN & "_1" & ".xls"
    Columns("Y:IV").NumberFormat = "0.000"
    Application.Run "RIJENSAMENVOEGEN"
    Workbooks.Open Filename:="C:\data\sap\" & FN & "_2" & ".xlsm"
    Workbooks(FN & "_2" & ".xlsm").Activate
    
'hier bedoel je wellicht ?

    rijen = Cells(Rows.Count, 1).End(xlUp).Row
    Rows("8" & ":" & rijen).Copy
    Range("A8").PasteSpecial xlPasteValues
    
    
    Application.CutCopyMode = False
    Application.Goto [A1]
    Workbooks(FN & "_2" & ".xlsm").SaveAs "C:\data\sap\" & NFN
    Workbooks(FN & "_1" & ".xls").Close False
    Application.DisplayAlerts = True
End Sub

[edmoor]

Daar kan je ook gewoon dit gebruiken:

ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value

[stefano]

Pofferdorie, het lag voor het grijpen, maar ik durf zoiets niet makkelijk zelf te doen. Dank alvast

Sub HM2(FN As String, NFN As String) ' macro voor een plan met meerdere operaties (rijen samenvoegen)
' indien eindbestand open staat, afsluiten
    Dim Wb As Workbook
    On Error Resume Next
    Set Wb = Workbooks(NFN & ".xlsm")
    If Err.Number = 0 Then
        MsgBox "Bestand " & Wb.Name & " staat nog open, dit wordt afgesloten zonder opslaan"
        Wb.Close
    End If
' einde afsluiten
    Application.DisplayAlerts = False
    Workbooks.OpenText Filename:="C:\data\sap\" & FN & "_1" & ".xls"
    Columns("Y:IV").NumberFormat = "0.000"
    Application.Run "RIJENSAMENVOEGEN"
    Workbooks.Open Filename:="C:\data\sap\" & FN & "_2" & ".xlsm"
    Workbooks(FN & "_2" & ".xlsm").Activate
    ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
    Workbooks(FN & "_2" & ".xlsm").SaveAs "C:\data\sap\" & NFN
    Workbooks(FN & "_1" & ".xls").Close False
    Application.DisplayAlerts = True
End Sub

[stefano]

Ja en na gebruik door de eindgebruikers heb ik het door waarom ...

In het sheet mogen enkel rijen 8 tot en met de laatste rij gekopiëerd en geplakt worden en NIET de volledige range. In die eerste rijen staan formules subtotal die actief moeten blijven na het kopiëren en plakken. Dat was de reden voor het gebruik van onderstaande code.

    rijen = Cells(Rows.Count, 1).End(xlUp).Row
    Rows("8" & ":" & rijen).Copy
    Range("A8").PasteSpecial xlPasteValues

met onderstaande code zijn die formules dus weg ...

ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value

[Haije]

n hoe werkt dit:

ActiveSheet.UsedRange.Offset(8).Value = ActiveSheet.UsedRange.Offset(8).Value

?

[stefano]

Ik zou zeggen: P R I M A

dank je wel !