Selecteer range voor elke sheet gedefinieerd in cel A1,A2,A3

[Ralf1991]

Beste helper,

Bekijk bijlage Helpfile.xlsx

Zie bijgevoegd bestand.

Ik ben op zoek naar een stuk VBA code waarbij de sheets een voor een geselecteerd worden die zijn gedefinieerd in Sheet1 kolom A.

Voor elke sheet moet range A1:G10 gekopieerd worden en geplakt in sheet Data sheet.

Alvast bedankt!

 

[Roeland035]

Hoe moet het geplaatst worden in "Data sheet"? Onder elkaar, naast elkaar?

 

[Ralf1991]

Onder elkaar

 

[VenA]

bv

Sub VenA()
For Each cl In Sheet1.Columns(1).SpecialCells(2)
  Sheets(cl.Value).Range("A1:G10").Copy Sheet5.Cells(Rows.Count, 1).End(xlUp).Offset(1)
Next cl
End Sub

 

[Roeland035]

bv

Sub VenA()
For Each cl In Sheet1.Columns(1).SpecialCells(2)
  Sheets(cl.Value).Range("A1:G10").Copy Sheet5.Cells(Rows.Count, 1).End(xlUp).Offset(1)
Next cl
End Sub

Ik hou al op haha, je wilt niet weten hoe lang mijn code is x) het werkt overigens wel, maar dit stukje is toch wel wat efficiënter ^^

 

[Roeland035]

Om zelf ook weer wat te leren heb ik de code van VenA gebruikt. Hij werkte niet in één keer voor mij, maar wel met kleine aanpassingen:

Sub VenA()

Dim cl As Range

For Each cl In Sheets("Sheet1").Columns(1).SpecialCells(2)
  Sheets(cl.Value).Range("A1:G10").Copy Sheets("Data sheet").Cells(Rows.Count, 1).End(xlUp).Offset(1)
Next cl
End Sub

 

[Ralf1991]

VenA,

Bedankt voor jouw reactie. Dit is bijna precies waar ik naar op zoek ben. Om het helemaal compleet te maken...

Nu is de range in kolom A hard gecodeerd. Als ik een sheet wil toevoegen moet ik dit ook in kolom A toevoegen en het stuks macro SpecialCells(2) wijzigen naar SpecialCells(3)

Is het ook mogelijk om een vooraf gedefineerde range op te nemen, A1:A20 bijvoorbeeld.

Als ik nu de macro aanpas naar SpecialCells(19) doet de macro het niet meer omdat er geen waardes in de cellen staan.

Alvast super bedankt!

Roeland035 jij ook bedankt!!

 

[Roeland035]

Zoiets ralph?

Sub VenA()

Dim strArray() As String
Dim TotalRows As Long
Dim ws As Variant
Dim i As Long

TotalRows = Rows(Rows.Count).End(xlUp).Row
ReDim strArray(1 To TotalRows)

For i = 1 To TotalRows
    strArray(i) = Range("A" & i).Value
Next

For Each ws In strArray
  Sheets(ws).Range("A1:G10").Copy Sheets("Data sheet").Cells(Rows.Count, 1).End(xlUp).Offset(1)
Next ws

 

[VenA]

Dit zijn allemaal onnodige aanpassingen.

Maak een nieuw tab aan, geef deze de naam Klant4 en zet wat gegevens in het bereik A1 tm G10. Zet in het blad 'Sheet1' in bv A30 Klant4 en draai mijn code eens. Zie ook https://msdn.microsoft.com/en-us/library/office/ff196157.aspx

 

[Ralf1991]

Ik ga er mee aan de slag. Dit heeft mij al zeer goed op weg geholpen.

Beide hartstikke bedankt en fijne feestdagen