Kopieren laatste 20 waarden uit verschillende sheets naar 1 sheet

[Arito]

Ik heb enkele tientallen sheets met data die door een macro dagelijks aangemaakt worden. Ik wil uit deze sheets (het gemiddelde van) de laatste 20 waarden van 2 kolommen (U en AI) kopieren naar een nieuwe sheet. Een voorbeeld van een van deze sheets is bijgevoegd. Ik heb alle kolommen die irrelevant waren weggehaald. De titel van de sheet is altijd de 'NAME' in kolom A.

Als het niet (of lastig) via een formule te realiseren is om ook automatisch naar een bepaalde sheet te zoeken voor de data (dus bijvoorbeeld, in de nieuwe sheet tik ik ABC in en automatisch worden dan naar de waardes in het excel bestand 'ABC' gezocht) vind ik het totaal geen probleem om naar elke sheet handmatig te linken. Ik hoef het immers maar een keer te doen voor ca. 40 sheets en dat is heel goed te doen.

Het gaat mij dus meer om de formule van laatste 20 waardes te pakken. De sheets waar de data uit gehaald moeten worden zijn variabel in lengte (aantal rijen). Elke dag komt er een regel bij. Bij sommige is de data al jaren opgehaald, bij anderen (zoals het voorbeeld) 10 dagen. Dit is ook iets wat de formule zal compliceren, ik wil de laatste 20 waarden, indien er 20 of meer rijen met data zijn. Anders wil ik gewoon het gemiddelde van alle waarden in de desbetreffende kolommen (D en E)

Ik hoop dat jullie me hiermee kunnen helpen.


mvg,

 

[snb]

Uitgegaan van jouw voorbeeld.
kolom D : columns(4)
kolom E : columns(4).offset(,1)

er wordt gekopieerd naar cel K1

Sub tst()
    x = Columns([COLOR="SeaGreen"]4[/COLOR]).SpecialCells(xlCellTypeConstants).Count
    With Cells(x + IIf(x < 21, 20 - x, 0),[COLOR="seagreen"] 4[/COLOR]).Offset(-19).Resize(20)
        Range(.Address, .Offset(, [COLOR="seagreen"]1[/COLOR]).Address).Copy [K1]
    End With
End Sub

voor kolom U en AI

Sub tst()
    x = Columns([COLOR="seagreen"]21[/COLOR]).SpecialCells(xlCellTypeConstants).Count
    With Cells(x + IIf(x < 21, 20 - x, 0), [COLOR="seagreen"]21[/COLOR]).Offset(-19).Resize(20)
        Range(.Address, .Offset(, [COLOR="seagreen"]15[/COLOR]).Address).Copy [K1]
    End With
End Sub

 

[Arito]

Kolom AI en U was ik vergeten weg te halen in de openingspost, dat was voordat ik alle kolommen had gedelete. Het is me gelukt om de macro te maken (lekker moeilijk copy/pasten zou je zeggen, maar ik had nog geen ervaring met visual basic).

Weet je echter hoe ik in de code zou kunnen refereren naar een andere sheet? Laten we zeggen dat de locatie van de sheet S:\TEST\ABC.xls is. Hoe kan ik dit in die code verwerken?

 

[Wigi]

Zoiets dan.

Sub ddd()

Dim wbData As Workbook
Dim wsData As Worksheet

Application.ScreenUpdating = False

Set wbData = Workbooks.Open("S:\TEST\ABC.xls")
Set wsData = wbData.Worksheets("naamvanhetblad")

'werk dan verder met wsData

wbData.Close SaveChanges:=False

Application.ScreenUpdating = True

Set wbData = Nothing
Set wsData = Nothing

End Sub

Wigi

 

[Arito]

'werk dan verder met wsData

In plaats van deze text moet ik:

x = Columns(4).SpecialCells(xlCellTypeConstants).Count
With Cells(x + IIf(x < 21, 20 - x, 0), 4).Offset(-19).Resize(20)
Range(.Address, .Offset(, 1).Address).Copy [K1]
End With

plaatsen? Ik snap niet zo goed wat die zin betekent.


mvg,

 

[Wigi]

wsData verwijst naar het tabblad met de gegevens.

x = [B]wsData[/B].Columns(4).SpecialCells(xlCellTypeConstants).Count
With [B]wsData.[/B]Cells(x + IIf(x < 21, 20 - x, 0), 4).Offset(-19).Resize(20)
Range(.Address, .Offset(, 1).Address).Copy [K1]
End With

 

[Arito]

Ok duidelijk.

Ik heb nu dit staan:

Sub ddd()

Dim wbData As Workbook
Dim wsData As Worksheet

Application.ScreenUpdating = False

Set wbData = Workbooks.Open("S:\Alexis\ABC.xls")
Set wsData = wbData.Worksheets("Sheet1")

x = wsData.Columns(4).SpecialCells(xlCellTypeConstants).Count
With wsData.Cells(x + IIf(x < 21, 20 - x, 0), 4).Offset(-19).Resize(20)
Range(.Address, .Offset(, 1).Address).Copy [K1]
End With

wbData.Close SaveChanges:=False

Application.ScreenUpdating = True

Set wbData = Nothing
Set wsData = Nothing

End Sub

Dit levert echter nog niets op. Het ABC bestand is dezelfde als die ik in mijn eerste post heb bijgevoegd. Mis ik iets?

Het bestand wordt overigens wel goed geopend en afgesloten. Er wordt alleen niets gekopieerd.

 

[Wigi]

Er zal wel degelijk naar cel K1 gekopieerd worden.

Geef die K1 een volledige verwijzing naar de juiste K1 (je hebt nu al 2 bestanden open, + zeg aan VBA op welk blad die K1 is), en dan zal het wel lukken.

 

[snb]

Als je het excel-bestand S:\Alexis\ABC.xls aan dit bestand koppelt en de gegevens ervan inleest met

Sub Excelbestand_invoegen()
  With ActiveSheet.QueryTables.Add("ODBC;DSN=Excel-bestanden;DBQ=[COLOR="Teal"]S:\Alexis\ABC.xls[/COLOR];DriverId=790;", Range("A1"))
    .CommandText = "SELECT `Blad1$`.*" & Chr(13) & "FROM `[COLOR="teal"]S:\Alexis\ABC[/COLOR]`.`Blad1$` "
    .Refresh False
  End With
End Sub

kun je mijn vorige code met 1 aanvulling gebruiken.

Sub arito2()
  With ActiveSheet
    .QueryTables(1).Refresh False
    x = .Columns(4).SpecialCells(xlCellTypeConstants).Count
    With .Cells(x + IIf(x < 21, 20 - x, 0), 4).Offset(-19).Resize(20)
      .Range(.Address, .Offset(, 1).Address).Copy activesheet.[K1]
    End With 
  End With
End Sub

Het voordeel van de koppeling is, dat je gegevens op ieder gewenst moment gesynchroniseerd/geaktualiseerd worden.
Daarna kun je de kopieermacro uitvoeren.

Met een lus kun je in het verzamelwerkboek de koppelingen naar alle 20 bestanden leggen, de koppelingen aktualiseren en vervolgens de integratie-macro uitvoeren.
NB. We zijn natuurlijk allang niet meer op het nivo van 'les 3 van de Basiscursus Excel'.

 

[Arito]

Dat realiseer ik me!

Bedankt voor de hulp, ik ben weer een flinke stap verder gekomen!