[vba] copy pasten van ranges

Pagina: 1
Acties:

  • Tom-my
  • Registratie: November 2000
  • Laatst online: 21-05-2025

Tom-my

w03iz0rz

Topicstarter
Probeer nu al een tijdje in 1 workbook alle worksheets te copieren naar een nieuwe worksheet in dat workbookje (klinkt logisch hè? :))


Probleem is dat ik geen vba progger ben en dat ik voorbeelden en tutorials aan het aan elkaar plakken ben, misschien kan iemand me vertellen dat deze code veel makkelijker kan, en waarom ik niet de row count kan opvragen op deze manier :S.

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
    '------------------
    'copy paste special  ** start
    '------------------
    
    '
     Workbooks(trustfile).Activate 'pak trust file
     Application.DisplayAlerts = False 'geen gezeur van office laten zien
     intWorksheetCount = ActiveWorkbook.Worksheets.Count
         
    'maak worksheet aan
    Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
    'geef naam aan nieuwe werkblad
    ActiveSheet.Name = "Copy paste"
    
    For x = 1 To intWorksheetCount
      xcount = Worksheets.Item(x).Selection.SpecialCells(xlCellTypeLastCell).Row '<- dit mag niet :S wrom niet? 
      Worksheets.Item(x).Range("a13:k" & xcount).Cut
      Worksheets("Copy paste").Range.Paste
    Next x
    '------------------
    'copy paste special  ** end
    '------------------

[ Voor 8% gewijzigd door Tom-my op 03-08-2004 10:47 ]

"Then there was the man who drowned crossing a stream with an average depth of six inches."


  • Tom-my
  • Registratie: November 2000
  • Laatst online: 21-05-2025

Tom-my

w03iz0rz

Topicstarter
dubbelpost :S soz

[ Voor 98% gewijzigd door Tom-my op 03-08-2004 10:47 ]

"Then there was the man who drowned crossing a stream with an average depth of six inches."


  • Lustucru
  • Registratie: Januari 2004
  • Niet online

Lustucru

26 03 2016

Selection is geen eigenschap/methode van een worksheet. specialcells kun je wel gebruiken icm worksheet.range

De oever waar we niet zijn noemen wij de overkant / Die wordt dan deze kant zodra we daar zijn aangeland


  • Bolhuis
  • Registratie: Juli 2004
  • Laatst online: 11-10-2006
Probeer dit eens.


code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub CPS()

Dim AantalSheets As Integer
Dim Teller As Integer
Dim RijNummer As Integer
Dim InvoegRij As Integer

AantalSheets = ActiveWorkbook.Worksheets.Count
         
Worksheets.Add.Move after:=Worksheets(AantalSheets)
ActiveSheet.Name = "Copy paste"

InvoegRij = 1
For Teller = 1 To AantalSheets
   Worksheets(Teller).Activate
   RijNummer = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
   ActiveSheet.Range("a13:k" & RijNummer).Copy
   Worksheets("Copy paste").Range("a" & InvoegRij).PasteSpecial
   InvoegRij = InvoegRij + RijNummer - 12
Next Teller

End Sub


Succes