Selecteren van bereik

[Batigoal80]

Ik wil een bepaald bereik selecteren om te kopiëren. Naar een anderblad waar vervolgens een grafiek van wordt gemaakt.
Ik heb een klein voorbeeld hierbij gevoegd.

In mijn macro laat ik kolom B filteren en daarna eventueel verbergen. mijn macro verbergd ook de andere kolommen. Omdat ik bijvoorbeeld alleen de uren van de techniek wil zien in een grafiek.

Ook in het voorbeeldbestand zijn er twee kolommen verborgen.(C en D)

Nu wil ik (na het eventueel verbergen van kolom B) de overgebleven cellen van kolom A en C kopieëren.

Kolom A is geen probleem namelijk:

Sheets(sheet1).Select
Sheets(sheet1).Range("a2").Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Grafiek_gegevens").Select
Range("a2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Kolom C is lastiger

dit gaat niet met .end(x1down) Omdat niet alle cellen zijn gevuld.
dit gaat ook niet met een integer omdat dan ook de gefilterde cellen meegekopieërd worden.


Ik heb bijvoorbeeld wel de kolom kunnen identificeren met:
lngcolumn = Sheets(sheet1).Range("a1").SpecialCells(xlCellTypeVisible).End(xlToRight).Column`

Ik kan ook de hele kolom kopiëren maar ik kom niet uit hoe ik dat moet opschrijven
bijvoorbeeld
Range(lngcolumn).select
selection.copy


groet wouter

 

[brandernl]

In kolom C kan je het ook andersom doen.

Range(Range("C1"), Range("C65536").End(xlUp)).Copy

 

[Batigoal80]

Klopt maar de macro moet juist zo geschreven zijn dat het ook kolom D, E of F enz kan betreffen.

De macro verbergt al alle kolommen die ik niet nodig heb maar moet juist de overgebleven kolom selecteren.

Deze is dus aan te duiden door 1xtoright als (lngcolumn) maar dan moet ik de kolom lngcolumn selecteren.

groet wouter

 

[brandernl]

als die "lngcolumn" de goede kolom is, kan je de code zo aanpassen

Range(Range(lngcolumn& "1"), Range(lngcolumn & "65536").End(xlUp)).Copy

 

[Batigoal80]

ik krijg een compileerfout

verwacht een ( of scheidingsteken

oeps gewoon een spatie tussen lngcolumn en &.

nu krijg ik fout 1004 tijdens uitvoering:

Methode Range van object _ global mislukt

 

[brandernl]

Doe eens een voorbeeldbestand?

 

[Batigoal80]

Ik heb het eerste voorbeeldbestand even aangepast. hierin staat ook een macro, die is volledig uitvoerbaar tot het laatst. ik heb jou oplossing even toegevoegd aan de macro.

groet wouter

doormiddel van het invullen van cellen b3 en b4 op het blad grafiek wordt het blad grafiek gegevens gevuld.

 

[brandernl]

Wouter,

1. de lngColumn werd niet "gedimd"
2. waar moet ie kopie naar toe?

Of gewoon vertellen wat er moet gebeuren?
Iets van: deze kolom kopiëren van dit blad naar dat blad enz.

 

[Batigoal80]

Ik was vergeten de juiste Dim over te nemen.

de lngcolumn kan in zijn geheel overgenomen worden en geplaatst in blad "grafiek_gegevens" kolom B.
hier mogen dus niet de gefilterde cellen worden meegenomen.

groet wouter

 

[Finch]

Batigoal zeg eens in mensentaal wat je wil bekomen, want dat is me nog niet helemaal duidelijk. Ik heb je code even bekeken, en denk dat die efficienter kan maar dan zou ik moeten weten wat resultaat je wil bekomen.

 

[Batigoal80]

ik maak een macro waarmee grafieken opgevraagd kunnen worden.
Het grafiek trekt zijn gegevens uit het blad (grafiek_gegevens)
Door middel van het invullen van de cellen b3 en b4 op het blad "grafiek" wordt het blad grafiek_gegevens gevuld.

In de macro lukt het me niet op de kolom die in cel b4 bepaald wordt te kopieëren.

In het voorbeeldbestand heb ik de grafiek zelf niet toegevoegd omdat het mij irrelevant leek.

samenvatting:
De macro moet naast wat het al doet. De kolom die overblijft (na de selectie op b4) kopieëren naar het blad "grafiek_gegevens" kolom B.

Ik hoop dat ik het zo duidelijk heb uitgelegd

groet wouter

 

[Batigoal80]

Nog even een toevoeging.

De macro bepaald de overgebleven kolom = (lngcolumn) (zie onderaan in dit bericht)
mijn belangrijkste vraag is hoe geef ik aan dat ik lngcolumn wil kopïeëren naar blad "grafiek_opvragen" kolom B





lngcolumn = Sheets(wsdata).Range("a1").SpecialCells(xlCellTypeVisible).End(xlToRight).Column`

 

[Wigi]

Zo waarschijnlijk:

Range(Cells(1, lngcolumn), Range(Rows.Count, lngcolumn).End(xlUp)).Copy

of

Columns(lngcolumn).Copy

Wigi

 

[brandernl]

Wouter,
Ik heb hem wat aangepast en hij werkt bij mij

Sub selectie()
Dim i As Range
Dim lastRow As Integer
Dim lastCol As Integer
Dim sFindKPI As String
Dim sFindshift As String
Dim wsinvoer As String
Dim wsdata As String
Dim wsgraf As String
Dim rngdata As Range

'Application.ScreenUpdating = False

wsgraf = "grafiek_gegevens"
wsinvoer = "Grafiek"
wsdata = "database"

sFindKPI = Sheets(wsinvoer).Range("b4").Value
sFindshift = Sheets(wsinvoer).Range("b3").Value

Sheets(wsdata).Range("A:e").EntireColumn.Hidden = False
Selection.AutoFilter Field:=2

For Each i In Sheets(wsdata).Range("c1:f1")
    If i <> sFindKPI Then
    i.EntireColumn.Hidden = True
    End If
Next

Set rngdata = Sheets(wsdata).Range("A2:B2", Sheets(wsdata).Range("A2").End(xlDown))

rngdata.AutoFilter 2, sFindshift

Sheets(wsdata).Range("B:B").EntireColumn.Hidden = True

Sheets(wsdata).Range("a2").End(xlDown).Copy Sheets(wsgraf).Range("a2")
Sheets(wsdata).Select
lastRow = Sheets(wsdata).Range("a1").SpecialCells(xlCellTypeVisible).End(xlToRight).Row
lastCol = Sheets(wsdata).Range("a1").SpecialCells(xlCellTypeVisible).End(xlToRight).Column
Sheets(wsdata).Range(Cells(1, lastCol), Cells(65536, lastCol).End(xlUp)).Copy Sheets(wsgraf).Range("B2")

End Sub

 

[Batigoal80]

Deze werken allebij.
Reuze bedankt. Wat een simpele oplossing eigenlijk. Snap niet dat ik dit zelf niet gezien heb.

Groet Wouter