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
-macro 2Code:Sub macro_vandaag() Call HM2("TOV", "Tarweontvangsten vandaag") End Sub
in bovenstaande code wordt een derde macro opgeroepen (rijensamenvoegen)Code: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
Code: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
haast je als je tijd hebt, dan heb je tijd als je haast hebt
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
Laatst aangepast door edmoor : 1 augustus 2020 om 12:03
"It's hardware that makes a machine fast. It's software that makes a fast machine slow. "
Op rechtstreekse vragen via email of privébericht reageer ik niet. Daar is het forum voor.
Lees ook: http://www.helpmij.nl/forum/announcement.php?f=5
Er zijn andere manieren om data om te zetten in waarden.
Waarom open je een .xls met de OpenText methode?
____________
Met vriendelijke groet,
Harry
Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
(Grunnegs-Gronings)
@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?
Code:Cells.Copy Application.Goto [A1] Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False
haast je als je tijd hebt, dan heb je tijd als je haast hebt
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:
Met Cells.Copy gebruik je het adres $1:$1048576Code:ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
En dat neemt inderdaad nogal wat ruimte in het geheugen in beslag.
Met mijn voorbeeld gebeurt dat niet.
Laatst aangepast door edmoor : 1 augustus 2020 om 14:46
"It's hardware that makes a machine fast. It's software that makes a fast machine slow. "
Op rechtstreekse vragen via email of privébericht reageer ik niet. Daar is het forum voor.
Lees ook: http://www.helpmij.nl/forum/announcement.php?f=5
Code vervangen, dit werkt , alhoewel het nu merkelijk trager gaat (max 5 sec).
dank !
haast je als je tijd hebt, dan heb je tijd als je haast hebt
Dat lijkt me vreemd, maar goed, als je het zo in orde vind is dat prima uiteraard.
"It's hardware that makes a machine fast. It's software that makes a fast machine slow. "
Op rechtstreekse vragen via email of privébericht reageer ik niet. Daar is het forum voor.
Lees ook: http://www.helpmij.nl/forum/announcement.php?f=5
Je hebt toch niet alleen Application.CutCopyMode = False vervangen door ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value hoop ik?
"It's hardware that makes a machine fast. It's software that makes a fast machine slow. "
Op rechtstreekse vragen via email of privébericht reageer ik niet. Daar is het forum voor.
Lees ook: http://www.helpmij.nl/forum/announcement.php?f=5
Ik heb er dit van gemaakt:
Code: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
haast je als je tijd hebt, dan heb je tijd als je haast hebt
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
Laatst aangepast door edmoor : 1 augustus 2020 om 20:31
"It's hardware that makes a machine fast. It's software that makes a fast machine slow. "
Op rechtstreekse vragen via email of privébericht reageer ik niet. Daar is het forum voor.
Lees ook: http://www.helpmij.nl/forum/announcement.php?f=5
ik weet niet hoe ik het kan vervangen . Kan je helpen?
Code: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
haast je als je tijd hebt, dan heb je tijd als je haast hebt
Daar kan je ook gewoon dit gebruiken:
Code:ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
"It's hardware that makes a machine fast. It's software that makes a fast machine slow. "
Op rechtstreekse vragen via email of privébericht reageer ik niet. Daar is het forum voor.
Lees ook: http://www.helpmij.nl/forum/announcement.php?f=5
Pofferdorie, het lag voor het grijpen, maar ik durf zoiets niet makkelijk zelf te doen. Dank alvast
Code: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
haast je als je tijd hebt, dan heb je tijd als je haast hebt
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.
met onderstaande code zijn die formules dus weg ...Code:rijen = Cells(Rows.Count, 1).End(xlUp).Row Rows("8" & ":" & rijen).Copy Range("A8").PasteSpecial xlPasteValues
Code:ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
haast je als je tijd hebt, dan heb je tijd als je haast hebt
n hoe werkt dit:
?Code:ActiveSheet.UsedRange.Offset(8).Value = ActiveSheet.UsedRange.Offset(8).Value
Haije
___________________________________________________
Ik zou zeggen: P R I M A
dank je wel !
haast je als je tijd hebt, dan heb je tijd als je haast hebt