gegevens van 72 tabbladen verplatsen naar een blad

[nojat]

hallo

ik wil van 72 tabbladen de gegevens verplaatsen naar een blad
de gegevens op de tabbladen staan op de zelfde plek vb van b6 tot b14

blad 1 gaat naar verzamelblad b6 tot b14
blad 2 gaat naar ,, c6 tot c14
enz

als ik de eerste met de hand doe en daarna op het verzamel blad b6 tot b14
copieerd verwachte ik van excel dat hij de informatie automatisch van blad2
daarna blad3 enz neemt dit moet toch mogelijk zijn maar hoe ?????

nojat

 

[LucB]

Hallo nojat,

Ik ga er van uit dat je 1e Blad "Verzamelblad" heet.

Run vanaf dit blad onderstaande Macro:

Sub verzamelen()
Dim n As Long
With ActiveSheet
For n = 2 To Sheets.Count
Sheets(n).Range("B6:B14").Copy Sheets("Verzamelblad").Range("A6").Offset(0, n - 1)
Next n
End With
End Sub

 

[nojat]

Hallo nojat,

Ik ga er van uit dat je 1e Blad "Verzamelblad" heet.

Run vanaf dit blad onderstaande Macro:

Sub verzamelen()
Dim n As Long
With ActiveSheet
For n = 2 To Sheets.Count
Sheets(n).Range("B6:B14").Copy Sheets("Verzamelblad").Range("A6").Offset(0, n - 1)
Next n
End With
End Sub

hallo bedankt voor de snelle en doordachte oplossing

als het een reeks is met een bereik van bijv. a1:d20
veranderd dan alleen de range naar range("a1:d20")

alvast bedankt

 

[LucB]

nojat,

Dat gaat niet.
A120 beslaat 4 kolommen.
Dit maal 72 geeft 288 kolommen en
je hebt er maar 256.
Even wachten op XL12-versie.

Als het naar beneden kopieren een optie is,
dat zou wel kunnen.

 

[nojat]

nojat,

Dat gaat niet.
A120 beslaat 4 kolommen.
Dit maal 72 geeft 288 kolommen en
je hebt er maar 256.
Even wachten op XL12-versie.

Als het naar beneden kopieren een optie is,
dat zou wel kunnen.

Ja dan dat maar het mag dan na 240 naar beneden verder

 

[LucB]

nojat,

Deze doet het bij mij.

Sub verzamelen()
Dim n As Long
Dim x As Long
Application.ScreenUpdating = False
With ActiveSheet
Range("A240") = "Begin"
For n = 2 To Sheets.Count
x = Cells(Rows.Count, "A").End(xlUp).Row
Sheets(n).Range("A120").Copy Sheets("Verzamelblad").Range("A" & x + 2)
Sheets("Verzamelblad").Range("A" & x + 1) = Sheets(n).Name
Next n
End With
Application.ScreenUpdating = True
End Sub

 

[nojat]

nojat,

Deze doet het bij mij.

Sub verzamelen()
Dim n As Long
Dim x As Long
Application.ScreenUpdating = False
With ActiveSheet
Range("A240") = "Begin"
For n = 2 To Sheets.Count
x = Cells(Rows.Count, "A").End(xlUp).Row
Sheets(n).Range("A120").Copy Sheets("Verzamelblad").Range("A" & x + 2)
Sheets("Verzamelblad").Range("A" & x + 1) = Sheets(n).Name
Next n
End With
Application.ScreenUpdating = True
End Sub

bedant werkt aks een trein