• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Kopieren aan de hand van celinhoud

Status
Niet open voor verdere reacties.

bowlingman

Gebruiker
Lid geworden
17 okt 2007
Berichten
433
Hallo,
Is het mogelijk om een bepaald gedeelte van een sheet te kopieren naar een andere sheet aan de hand van een button en een bepaalde celinhoud.
Momenteel doe ik dit in een ander prog op de volgende wijze, maar dit zijn steeds verschillende sheets (speeldagen)
Code:
Sub Kopie()
    Range("A1:AG11,A19:AG27,A35:AG43,A51:AG59").Copy
    Workbooks.Open "C:\Users\Armand\Documents\Bowling 2017-2018\Metropool Liga\Mario\Speeldagen.xlsx"
    ActiveWorkbook.Sheets("Blad2").Range("A1").PasteSpecial xlPasteValues
    Application.Goto Cells(1)
    Application.CutCopyMode = True
End Sub
In het nieuwe prog waar ik nu aan bezig ben staan alle speeldagen op 1 sheet
Meer uitleg van wat de bedoeling is staat in de file

Grtjs.
Armand
 

Bijlagen

  • Kopieren.xlsx
    22,2 KB · Weergaven: 23
Komt dit in de richting wat je bedoelt?
Code:
 i = Range("B2").Value - 1
 Blad1.Cells(5 + i * 21, 1).Resize(20, 11).Copy Blad2.Range("A5")
 
Volgens mij zat ik fout.
Dus bij deze een code op je benoemde namen.
Code:
Range("Speeldag" & Blad1.Range("B2").Value).Copy Blad2.Range("A5")
 
Laatst bewerkt:
Bedankt Jack,

De tweede code werkt perfect.
Dit is de uiteindelijke code die nu in mijn progje zit

Code:
Sub Kopie()
    With Sheets("Speeldagen")
        Range("Speeldag" & .Range("B1").Value).Copy
        Workbooks.Open "C:\Users\Armand\Documents\Bowling 2017-2018\Metropool Liga\Mario\Speeldagen2.xlsx"
        ActiveWorkbook.Sheets("Blad2").Range("A1").PasteSpecial xlPasteValues
        Application.Goto Cells(1)
        Application.CutCopyMode = True
    End With
End Sub

Grtjs.
Armand
 
Code:
Sub Kopie()
  Workbooks.Open Filename:=Environ("USERPROFILE") & "\Documents\Bowling 2017-2018\Metropool Liga\Mario\Speeldagen2.xlsx"
  With ThisWorkbook.Sheets("Speeldagen")
    .Range("Speeldag" & .Range("B1").Value).Copy ActiveWorkbook.Sheets("Blad2").Range("A1")
  End With
End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan