Alleen de tekst kopieren uit selectie naar andere selectie, zonder celformat

Status
Niet open voor verdere reacties.
A

abracadaver909

Gebruiker
Lid geworden
12 mrt 2011
Berichten
94
Beste Help Mij-ers,

Het is alweer een tijdje geleden dat ik hier wat gepost heb, dus alvast mijn excuses mocht ik iets niet correct hebben geplaatst.

Ik zit met het volgende:
Vanuit een door een macro gegenereerde selectie van cellen wil ik alleen de waardes kopiëren en plakken in een andere selectie van cellen op hetzelfde werkblad.
De enige methode die werkt is:

Code: 
ActiveSheet.Paste

Dit heeft tot gevolg dat het achtergrond kleurtje ook mee geplakt wordt. Dit is ongewenst.

Codes met special paste geven foutmeldingen. De rest van het script werkt naar behoren.

Dit is wat ik tot nu toe heb:

Code: 
Private Sub Workbook_Open()

Application.ScreenUpdating = False


Dim cell As range
Dim range1 As range


For Each cell In range("S20:S40")
If Len(cell.Value) > 0 And CDate(cell.Value) < Date Then

    cell.Select

    Selection.Offset(0, -2).Resize(2, 2).Copy

    Else: GoTo Volgende
End If
 
'selecteert bovenste cel in range
range("N20:N41").Cells(1).Select

'van geselecteerde cel wordt bepaald of deze inhoud heeft. Zoja, dan cel daaronder selecteren en deze actie herhalen. zo nee, plakken wat gekopieerd is.
Do While Len(ActiveCell.Value) > 0
    Selection.Offset(2).Select
Loop

[B] ActiveSheet.Paste[/B]

cell.Select
Selection.Offset(0, -2).Resize(2, 5).Value = Empty


Volgende:
Next

Application.ScreenUpdating = True

End Sub

Is er iemand die begrijpt wat hier gaande is en mij een duwtje in de juiste richting kan geven?

Bij voorbaat dank!
 
Wellicht dat je ook even aan kan geven hoe je PasteSpecial hebt gebruikt en welk foutmelding dat gaf.
 
Als ik
Code: 
ActiveSheet.PasteSpecial Paste:=xlPasteValues
gebruik, dan krijg ik de volgende melding:

Fout 1004 tijdens uitvoering:
Door de toepassing of door object gedefinieerde fout
Klik om te vergroten...

Dezelfde melding krijg ik bij
Code: 
Selection.PasteSpecial xlPasteValues
en zo ook bij
Code: 
ActiveCell.PasteSpecial Paste:=xlPasteValues

Ik hoop u hiermee voldoende informatie te hebben verschaft, want ik weet niet zo goed welke mogelijkheden ik nog meer zou kunnen toepassen.
 
Uitproberen op een kopie van je originele bestand.
Als je dat dikgedrukte uit je code in je startposting (=ActiveSheet.Paste) vervangt door:

Code: 
ActiveSheet.Activate
ActiveCell.PasteSpecial Paste:=xlPasteValues

Werkt het dan wel zoals gewenst?

Tijs.
 
Vergeet kopiëren in dit geval, maar gebruik

Code: 
range("P20")=range("S20").value
of tussen werkbalden
Code: 
Sheet2.range("P20")=Sheet1.range("S20").value

Vermijd in VBA altijd 'Select' en 'Activate'
 
Laatst bewerkt:
@snb: Ik meen te zien dat de range die gekopiëerd moet worden niet vast is (namelijk afhankelijk van voorwaarden)? En dat ook de cell/locatie waar geplakt moeten worden niet vast is (afhankelijk van voorwaarden)?
Ik zie dus geen mogelijkheden om simpelweg een kopieeractie met vaste ranges te programmeren die het resultaat oplevert waar de TS naar op zoek is.

Tijs.
 
Laatst bewerkt:
Klopt inderdaad. Daarom ook het select.

Maar ik krijg het ook niet voor elkaar om een variabele range in een dim vast te leggen, om zo toch de waardes tussen de 2 ranges uit te wisselen.

Misschien dat iemand daar een voorbeeld van kan geven?
 
Geen idee wat je daarmee bedoelt. Met Dim doe je niets anders dan het declareren van een variabele, dat staat helemaal los van de waarde(n) die de variabele op een gegeven moment krijgt.
 
@abracadaver909: Mijn code nog geprobeerd?

Tijs.
 
@Tijs

Ik wel

Code: 
For Each cl In range("S20:S40")
   If Len(cl.Value) > 0 And CDate(cl.Value) < Date Then cl.Offset(, -2)=cl.value
Next
 
@Tijs
Nog niet. Ik moet vandaag werken. Overmorgen heb ik een vrije dag, dus dan heb ik alle tijd om de aangeboden oplossingen te proberen.

Ik houd jullie op de hoogte en vriendelijk bedankt voor jullie respons!
 
@Allemaal

Ik ben eruit!
Dankzij deze discussie ben ik verder gaan zoeken in Value-oplossingen i.p.v. Copy-Paste en dit is het resultaat geworden. Vrij simpel eigenlijk, maar kom er maar eens op zonder een duwtje in de juiste richting :)

Code: 
Private Sub Workbook_Open()

Application.ScreenUpdating = False


Dim cell As range
Dim SelRange As range
Dim SelRange2 As range

For Each cell In range("U20:U40")
If Len(cell.Value) > 0 And CDate(cell.Value) < Date Then

cell.Select
Selection.Offset(0, -4).Resize(2, 2).Select
Set SelRange = Selection

Else: GoTo Volgende
End If
 
'selecteert bovenste cel in range
range("N20:N41").Cells(1).Select

'van geselcteerde cel wordt bepaalt of deze inhoud heeft. Zoja, dan cel daaronder selecteren en deze actie herhalen. zonee, plakken wat gekopieert is.
Do While Len(ActiveCell.Value) > 0
   Selection.Offset(2).Resize(2, 2).Select
Loop
Set SelRange2 = Selection
SelRange2.Value = SelRange.Value

    
cell.Select
Selection.Offset(0, -4).Resize(2, 5).Value = Empty


Volgende:
Next

Application.ScreenUpdating = True

End Sub

Hartelijk dank voor jullie hulp. Deze gaat op "Opgelost".
 
Wellicht doet deze exact hetzelfde (een voorbeeldbestand was helemaal niet verkeerd geweest)

Code: 
Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    
    With Sheet1
        For j = 20 To 40 Step 2
          If .Cells(j, 21) > 0 And CDate(.Cells(j, 21)) < Date Then .Range("N20:N41").SpecialCells(4).Areas(1).Resize(2, 2) = .Cells(j, 17).Resize(2, 2).Value
        Next
    End With
    
    Application.ScreenUpdating = True
End Sub
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan