Fout bij kopieeren met macro

[Atwist]

Hallo forumleden,

Ik probeer via een macro een range van een blad naar een ander blad ik heb deze macro gevonden op het forum gemaakt door Wigi.

Code:
Sheets("calculatie").Range("E32:I32").Copy
Sheets("Calc.overzicht").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues

Wigi

Deze heb ik aan gepast door

Private Sub CheckBox1_Click()
Sheets("Data1").Range("A1:M6").Copy
  Sheets("Brand").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    
End Sub

Maar ik krijg een fout melding 1004 "Methode PastSpecial van klasse range is mislukt".

Wat gaat hier dan mis???

 

[Hoornvan]

Atwist,

Heb je soms Samengevoegde cellen in het bereik dat gekopieerd word?

 

[Atwist]

Beste Hoornvan,

Heb je soms Samengevoegde cellen in het bereik dat gekopieerd word?

Dat klopt in de gekopieerde range zitten samengevoege cellen.

 

[Hoornvan]

Atwist,

Daar word steeds opgewezen dat dit voor problemen kan zorgen.
Dus denk ik dat dit het probleem is.

 

[Atwist]

Hoorvan,

Ik ga eens kijken of ik deze cellen kan los koppelen, ik zit namelijk met een vaste layout indeling.

 

[Atwist]

Heb alle samengevoegde cellen verwijderd, maar krijg weer fout 1004 maar nu met de tekst dat "alle samengevoegde cellen moeten dezelfde afmeting hebben"

 

[snb]

Vermijd copy / Paste(special):

Private Sub CheckBox1_Click()
  Sheets("Brand").cells(Rows.Count,1).End(xlUp).Offset(1).resize(6,18)=Sheets("Data1").Range("A1:M6").Value
End Sub

 

[Roncancio]

Heb alle samengevoegde cellen verwijderd, maar krijg weer fout 1004 maar nu met de tekst dat "alle samengevoegde cellen moeten dezelfde afmeting hebben"

Dat zijn er toch nog samengevoegde cellen in het bereik.
Je kunt in Excel 2007 laten zoeken naar samengevoegde cellen.

Met vriendelijke groet,


Roncancio

 

[Hoornvan]

Atwist,

Ik heb je code die je aangepast had naar je eigen wensen, getest en het werkt perfect.
De ene regel code van snb heb ik ook gebruikt en werkt ook perfect.

Dus aan de code ligt het niet.

Lukt het niet, zet dan het bestandje zonder gevoelige info hier.

 

[Warme bakkertje]

In bijlage zit een macro waarmee je in versie 2003 samengevoegde cellen kunt opsporen.

 

[Atwist]

@ SNB,

Ik had PastSpecial gebruikt om ook de celeigenschappen mee te kopieeren.

@ Roncancio,

Er stond op in het doel bereik nog 2 cellen samengevoegd.

@ Hoornvan,

U bestand werkt bijna perfect ik had ook graag de celeigenschappen mee gekopieerd.

@ Warme bakkertje,

Het probleem is opgelost zie : @Roncancio:thumb:

 

[Hoornvan]

Zet de vraag als opgelost, bedankt.

 

[Atwist]

Hoe kan ik deze code verbouwen zodat ik de celeigenschappen ook mee kan kopieeren, ik wil graag de rand opmaak en de vette tekst late meenemen.

Heb deze code van Hoornvan gekregen.

Sub Verplaats()
  Sheets("Brand").Cells(Rows.Count, 1).End(xlUp).Offset(0).Resize(6, 13) = Sheets("Data1").Range("A1:M6").Value
  'Sheets("Data1").Range("A1:M6").Copy
  'Sheets("Brand").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
End Sub

 

[Roncancio]

Sub Verplaats()
  Sheets("Brand").Cells(Rows.Count, 1).End(xlUp).Offset(0).Resize(6, 13) = Sheets("Data1").Range("A1:M6").Value
  Sheets("Data1").Range("A1:M6").Copy
  Sheets("Brand").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteAll
End Sub

Met vriendelijke groet,


Roncancio

 

[Atwist]

Beste Roncancio,

Ik heb de code aangepast maar de eigenschappen gaan niet mee, zie bestand

 

[Roncancio]

Beste Roncancio,

Ik heb de code aangepast maar de eigenschappen gaan niet mee, zie bestand

Ik zie de aanpassing niet.
Hoe dan ook, ik heb de code in het bestand geplaatst en volgens mij werkt het zoals je het voor ogen heeft.
Als dat niet zo is, dan hoor ik dat graag.

Met vriendelijke groet,


Roncancio

 

[Atwist]

Beste Roncancio,

Het werkt nu wel, zie niet wat het verschil is maar daar kom ik nog wel achter:thumb:

 

[Roncancio]

Het werkt nu wel, zie niet wat het verschil is maar daar kom ik nog wel achter:thumb:

Sub Verplaats()
  Sheets("Brand").Cells(Rows.Count, 1).End(xlUp).Offset(0).Resize(6, 13) = Sheets("Data1").Range("A1:M6").Value
  Sheets("Data1").Range("A1:M6").Copy
  Sheets("Brand").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial [COLOR="Red"][B]xlPasteAll[/B][/COLOR]
End Sub

Alleen de rode tekst is aangepast.
De code stond nog niet in het bestand.

Met vriendelijke groet,


Roncancio

 

[Hoornvan]

Atwist,

De bovenste regel code is van snb.
De andere regeels had ik een ' voorgezet, zodat je kon zien dat hij het ook met 1 regel doet.
Nu blijkt dat die regel niet de opmaak mee neem.
Dus kun je die regel verwijderen en heb je de onderste 2 regels maar nodig, die neemt de opmaak wel mee.

Sorry voor het ongemak.

 

[snb]

Vermijd copy /pastespecial

Als je alleen waarden wil overzetten gebruik dan:

Sub kopie_waarden()
  Sheets("Brand").Cells(Rows.Count, 1).End(xlUp).Offset(0).Resize(6, 13) = Sheets("Data1").Range("A1:M6").Value
End Sub

Als je waarden én opmaak wil overzetten gebruik dan:

Sub kopie_met_opmaak()
  Sheets("Data1").Range("A1:M6").Copy  Sheets("Brand").Range("A" & Rows.Count).End(xlUp).Offset(1)
End Sub

Gebruik pastespecial alleen als het niet anders kan: als je alleen opmaak wil kopiëren, wil transponeren of een berekening wil uitvoeren.