Kopiëren rijen naar ander werkboek en transponeren.

[ijskonijn34]

De nu gebruikte code lijkt mij te omslachtig voor het probleem.
Dit is een voorbeeld. Deze code moet ik normaal nog verder uitbreiden voor 31 rijen.

In Book_1.xlsm bevindt zich de code.
Book_1.xlsm en Book_2.xlsx bevinden zich in de map C:\temp , in de code wordt dit pad gebruikt om Book_2.xlsx te openen. Deze kan naar wens aangepast worden.
Werking:
Men opent Book_1.xlsm. De code wordt uitgevoerd door sneltoets: Ctrl+e , waaronder dus het openen van Book_2.xlsx.
Het is de bedoeling dat hier de rijen getallen van links naar rechts (boven naar onder) worden gekopieerd, getransponeerd en onder elkaar geplakt in Book_1.xlsm . In Book_1.xlsm worden deze onder elkaar geplakt vanaf cel A3.

Dit is een voorbeeld met 10 kolommen en 4 rijen.
In het werkelijke werkblad dat ik wil gebruiken bestaan de gegevens die moeten gekopieerd worden uit 24 kolommen en 31 rijen (ter info gemarkeerd in geel). En rondom de gegevens die ik wil overbrengen bevinden zich andere getallen.
Ter verduidelijking heb ik "Werkelijk werkblad.xlsx" bijgevoegd.

Hoe kan dit simpeler opgelost worden? Deze code verder uitbreiden voor de 31 rijen lijkt mij wat omslachtig.

Ik lees hier en hier ook dat vermeden moet worden om .Select, .Activate, ActiveSheet,ActiveCell, enz. te gebruiken in VBA-code.
Ik weet niet wat de bedoeling hiervan is, maar .Activate gebruik ik wel enige keren en als ik deze code voor 31 rijen zou uitbreiden zelfs meermaals dan.

 

[VenA]

Voor je voorbeeldbestandje kan je deze gebruiken. Is het in het werkelijke bestand een vaste range zoals nu geel gemarkeerd? Of is dit en variabele range? Zo ja wat is dan de voorwaarde?

Sub VenA()
Application.ScreenUpdating = False
Workbooks.Open "C:\temp\Book_2.xlsx"
ar = Sheets("Blad1").[e9].CurrentRegion
Workbooks("Book_2.xlsx").Close
For j = 1 To UBound(ar)
    For jj = 1 To UBound(ar, 2)
        c00 = c00 & "|" & ar(j, jj)
    Next jj
Next j
Sheets("Blad1").[A3].Resize(UBound(ar) * UBound(ar, 2)) = Application.Transpose(Split(Mid(c00, 2), "|"))
End Sub

 

[ijskonijn34]

Bedankt. Voor het voorbeeld werkt dit.

In het werkelijke bestand is de range niet geel gemarkeerd, naast zo een gele rij staat wel "S41"..
Het hier genoemde bestand "Werkelijk werkblad.xlsx" is een maandelijks gepubliceerd bestand (dit is een berekeningsparameter voor de aardgas, KCF-waarden). Het bestand "Werkelijk werkblad.xlsx" is dit van de maand maart 2015.
De range is variabel naargelang het aantal dagen van de maand. Voor de maanden met 31 dagen is deze hetzelfde, voor de maanden met 30 dagen ook. De maand februari is verschillend daar deze 28 of 29 dagen heeft (schrikkeljaar).
Mijn uiteindelijke bedoeling is om in "Book_1.xlsm" 12 kolommen te bekomen (januari t/m december), en hierin dus telkens elke maand de mij betreffende waarden uit het nieuwe gepubliceerde bestand over te brengen. Zoals je in "Werkelijk werkblad.xlsx" kan zien zijn de voor mij betreffende waarden de (gele) rijen waar ernaast S41 staat.

Dus van zo een maandelijks gepubliceerd bestand waarvan in de kolom S41 in de cellen staat, de waarden in de rijen naast S41 overbrengen naar "Book_1.xlsm". Als je de 1ste en 2de kolom van een gepubliceerde maand breder maakt zie je dat in feite de rijen, de dagen van de maand zijn, en de kolommen zijn dan de uren. 24 uur in een dag, dus 24 kolommen.

 

[VenA]

Op zich is het niet zo'n grote aanpassing maar hoe gaat het proces. Je gaat naar de website en slaat het bestand op of je opent het bestand? Hoe ziet de werkelijke lay-out van het doelbestand er uit? Het jaar en de maand zijn er vrij eenvoudig uit te halen en dus ook in de juiste kolom te zetten.

 

[ijskonijn34]

Ik ga naar de website en download het bestand. In het doelbestand (lay-out) zouden enkel kolommen staan van (januari t/m december).
In de eerste rij zouden de maanden benoemd worden. De tweede rij zou leeg zijn. Vanaf de derde rij zouden de gegevens ingevuld worden in de desbetreffende maand. Dus de gegevens moeten getransponeerd in het doelbestand terecht komen (zoals in het voorbeeld getoond).

Ik dacht eraan om in de code (die zich in het doelbestand bevindt) de benaming van het gedownloade bestand (dat aan een bepaalde maand toebehoort) ook hierin aan dezelfde maand toe te wijzen. Als dan ooit de benamingen van de gepubliceerde maandelijkse bestanden gewijzigd wordt kan ik deze in de code aanpassen. Ik sta natuurlijk open voor andere/betere oplossingen.
Dit zou voor 2015 dan zoiets zijn als:
KCF201501.csv = januari
KCF201502.csv = februari
KCF201503.csv = maart
KCF201504.csv = april
KCF201505.csv = mei
KCF201506.csv = juni
KCF201507.csv = juli
KCF201508.csv = augustus
KCF201509.csv = september
KCF201510.csv = oktober
KCF201501.csv = november
KCF201502.csv = december

 

[VenA]

Mogelijk komt dit in de buurt. Het bestand 'KCF201602.csv' heb ik even opgeslagen als KCF201602.xlsx

Sub VenA()
Application.ScreenUpdating = False
Workbooks.Open "C:\Temp\KCF201602.xlsx"
ar = Cells(1).CurrentRegion
Workbooks("KCF201602.xlsx").Close
For j = 1 To UBound(ar)
    If ar(j, 4) = "S41" Then
        For jj = 5 To UBound(ar, 2)
            c00 = c00 & "|" & ar(j, jj)
        Next jj
    End If
Next j
Sheets("Blad1").Cells(2, Val(Mid(ar(9, 1), 3, 2))).Resize(UBound(Split(c00, "|"))) = Application.Transpose(Split(Mid(c00, 2), "|"))
End Sub

 

[ijskonijn34]

Dit komt zeker aardig in de buurt.

Wel worden blijkbaar de getallen niet als getallen aanzien, ook al zie ik bij celeigenschappen "standaard" ingesteld staan. Getallen kleiner dan 1 hebben zo een groen driehoekje in linkerbovenhoek van de cel en staan links uitgelijnd.
Getallen gelijk of groter dan 1 worden helemaal raar weergegeven, staan wel rechts uitgelijnd.

Als ik zo een maandelijks gepubliceerd csv-bestand gedownload heb zal ik het openen en opslaan als ".xlsx" . Heb het voor de aardigheid toch ook maar eens getest als origineel ".csv" maar dat neemt hij toch niet aan. Is ook maar een kleine moeite.

In de code dan ook elke keer het bestand van de maand hernoemen of ineens alle 12 maanden erin verwerken?

Alvast nog maar eens bedankt voor de moeite.

 

[HSV]

Het komt doordat alles in een string is weggeschreven (c00).

Het zal in een array geschreven moeten worden.
Ik ga niet alles reproduceren, want @VenA zal dit klusje vast wel klaren

 

[VenA]

Het weer netjes terug krijgen vanuit een tweede array laat ik even aan HSV over.

Het is inderdaad niet handig om een bestandsnaam in de code op te nemen. Hiervoor kan je verschillende methoden gebruiken.
Ik heb even lopen spelen met het mij onbekende FileDialog. Hiermee kan je het gewenste bestand openen.

Sub VenA()
With Application
    .ScreenUpdating = False
    With .FileDialog(msoFileDialogOpen)
        .Show
        f = .SelectedItems(1)
    End With
End With
Workbooks.Open f
ar = Cells(1).CurrentRegion
ActiveWorkbook.Close
For j = 1 To UBound(ar)
    If ar(j, 4) = "S41" Then
        For jj = 5 To UBound(ar, 2)
            Sheets("Blad1").Cells(2, Val(Mid(ar(9, 1), 3, 2))).Offset(t) = ar(j, jj)
            t = t + 1
        Next jj
    End If
Next j
End Sub

Als je altijd in de huidige maand de gegevens van de vorige maand ophaalt dan kan je deze proberen

Sub VenA1()
Select Case [M2].End(xlToLeft).Column
    Case 1
        If [A2] = "" Then f = "KCF" & Year(Date) & "01" Else f = "KCF" & Year(Date) & "02"
    Case 11
        f = "KCF" & Year(Date) - 1 & "12"
    Case Else
        f = "KCF" & Year(Date) & Format(Month(Date) - 1, "00")
End Select
MsgBox "C:\temp" & f & ".xlsx"
End Sub

 

[ijskonijn34]

Ik ben even niet mee wat je bedoelt met:
Het weer netjes terug krijgen vanuit een tweede array laat ik even aan HSV over.
Want de eerste code lijkt toch te werken.

De tweede code doet precies niets, maar geen probleem want de eerste lijkt te werken.

Nog even verder testen. Ik hou je op de hoogte.

 

[VenA]

Gebruik svp de reageer knop. Ipv te quoten. Je kan jouw bericht aanpassen en het hele gedeelte weghalen.

Dat de code werkt komt doordat ik een voor jouw onzichtbare trage code gebruik.

De tweede code heb je niet goed getest. Deze geeft de nieuw te importeren bestandsnaam middels een msgbox

 

[HSV]

De iets snellere manier.

Sub hsv()
Dim arr, ar, j As Long, jj As Long
ReDim arr(0)
Application.ScreenUpdating = False
Workbooks.Open "C:\Temp\KCF201602.xlsx"
ar = Cells(1).CurrentRegion
ActiveWorkbook.Close 0
For j = 1 To UBound(ar)
    If ar(j, 4) = "S41" Then
        For jj = 5 To UBound(ar, 2)
           arr(UBound(arr)) = ar(j, jj)
           ReDim Preserve arr(UBound(arr) + 1)
        Next jj
    End If
Next j
Sheets("Blad1").[a3].Resize(UBound(arr)) = Application.Transpose(arr)
End Sub

Misschien is dit een optie.
Dit bestand is nergens van afhankelijk, behalve het runnen van de code en het bestand openen.

Sub hsv()
Dim arr, ar, hs
Dim j As Long, jj As Long, rij As Long, maand As Long, jaar As Long, laatstedag As Long
Dim wbname As String
ReDim arr(0)

With Application
 .ScreenUpdating = False
    With .FileDialog(msoFileDialogOpen)
        .InitialFileName = "C:\Temp\"
        .Show
       If .SelectedItems.Count = 1 Then
Workbooks.Open .SelectedItems(1)
  wbname = Replace(Replace(ActiveWorkbook.Name, "KCF", ""), ".xlsx", "")
  maand = Right(wbname, 2)
  jaar = Left(wbname, 4)
  rij = Columns(1).Find("01" & Format(maand, "00") & jaar, , xlValues, xlPart).Row
  ar = Cells(1).CurrentRegion
ActiveWorkbook.Close 0
laatstedag = Evaluate("day(date(""" & jaar & """,""" & maand & """ +1,0))")
  For j = rij To rij + laatstedag
        For jj = 5 To UBound(ar, 2)
           arr(UBound(arr)) = ar(j, jj)
           ReDim Preserve arr(UBound(arr) + 1)
        Next jj
  Next j
Sheets("Blad1").Cells(3, Columns.Count).End(xlToLeft).Offset(, 1).Resize(UBound(arr)) = Application.Transpose(arr)
     End If
   End With
 End With
End Sub

 

[ijskonijn34]

...
De tweede code heb je niet goed getest. Deze geeft de nieuw te importeren bestandsnaam middels een msgbox

Ik krijg een msgbox te zien waarbij ik op "OK" kan klikken, maar er gebeurd niets wanneer ik hierop klik.
Maar je andere versie is interessanter, degene waarbij men het bestand kan selecteren.

@HSV
De optie voor juist het runnen van de code en het bestand openen zou ik een goede werkwijze vinden. Ik veronderstel dat je bedoeld met "het bestand openen" dit het bestand is om de code te runnen.

Bij deze code kan men het bestand selecteren wat ik goed vind, maar er loopt ergens iets mis.
- Er worden allemaal andere getallen gecreëerd. Er worden ook 24 extra getallen gecreëerd (1 dag of 24 uur ??)
- Het maakt geen verschil welke maand ik selecteer, er wordt gestart in de tweede kolom en telkens een kolom opgeschoven. De maanden worden niet juist geplaatst.

Bij het testen met de eerste code van http://www.helpmij.nl/forum/showthr...transponeren?p=5735547&viewfull=1#post5735547 kwam bij het invullen van alle maanden van 2015 een ander probleem te voorschijn. Nl. Bij de maanden waar het uur (zomer- winteruur) aangepast wordt.
Bij de maand maart is er een lege cel (er bevindt zich een lege cel doordat er een uur wegvalt, twee uur wordt drie uur).
En bij de maand oktober zijn er verscheidene lege cellen (er wordt een extra uur gecreëerd, drie uur wordt twee uur). Doordat er een extra cel wordt ingenomen in de gepubliceerde maand oktober (zie bijgevoegd bestand "KCF201510.xlsx", heb deze geel gemarkeerd) voor de dag waar het uur is veranderd (deze dag heeft 25 uur), geeft de code alle andere dagen een extra lege cel.
Ik kan hier eventueel wel telkens de lege cellen apart verwijderen en de optie "cellen naar boven verplaatsen" kiezen.

 

[HSV]

De onderste code werkt als volgt.
Run de code → bestand kiezen.
Bv. KCF201601.xlsx
Ik ga er dan vanuit dat de gegevens in de eerste kolom in dat bestand staan (01012016 06:00)
Voor werkboek KFC201603 → 01032016 06:00).

Open je een ander werkboek, komen deze gegevens naast de laatst gevulde kolom te staan.

 

[ijskonijn34]

Ik heb de code in Testen code.xlsb gezet.
Als ik dan KCF201501.xlsx kies begint het van de eerste maal dat 01012015 06:00 gezien word t/m 01012015 06:00 volgende maal. Wat dus betekent dat dit de waarden zijn van S31 t/m de eerste rij van S32 (Ik dacht eerst dat er waarden gecreëerd werden). Het zijn niet de waarden die naast kolom S41 staan (die ik even geel gemarkeerd heb).
Uw eerste code nam wel de S41 waarden. Hier kan ik dan weer het bestand niet zelf kiezen, en wordt er niet onder de juiste maand weggeschreven zoals deze eerste code precies wel doet.
Uw eerste code houdt denk ik geen rekening met het uur 01012015 06:00, wat op zich dan weer goed is want tijdens de periode van het zomeruur starten de S41 waarden voor deze maanden om 05:00 (bv. april 01042015 05:00).

Dit maakt uw eerste code dan weer interessanter als hier een bestand kan gekozen en op de juiste plaats weggeschreven worden. Hierna zou ik misschien deze kunnen proberen om de lege cellen te verwijderen:

Sub legecellen()
Application.ScreenUpdating = False
For DKL = 75 To 1 Step -1
For DCL = 100 To 2 Step -1
If Cells(DCL, DKL) = "" Then
Cells(DCL, DKL).Delete Shift:=xlUp
End If
Next DCL
Next DKL
Application.ScreenUpdating = True
End Sub

 

[HSV]

Dan heb ik dat verkeerd begrepen.
Ik meende dat je bestandsnaam gelijk was aan de data in kolom A, wat de code veel sneller zal doen werken.

Test dit maar eens weer.

Sub hsv()
Dim arr, sn
Dim j As Long, jj As Long
ReDim arr(0)
With Application
 .ScreenUpdating = False
    With .FileDialog(msoFileDialogOpen)
        .InitialFileName = "C:\Temp\"
        .Show
       If .SelectedItems.Count = 1 Then
Workbooks.Open .SelectedItems(1)
  sn = Cells(1).CurrentRegion
ActiveWorkbook.Close 0
  For j = 2 To UBound(sn)
   If sn(j, 4) = "S41" Then
        For jj = 5 To UBound(sn, 2)
           arr(UBound(arr)) = sn(j, jj)
           ReDim Preserve arr(UBound(arr) + 1)
        Next jj
     End If
  Next j
Sheets("Blad1").Cells(3, Val(Mid(sn(9, 1), 3, 2))).Resize(UBound(arr)) = Application.Transpose(arr)
     End If
   End With
 End With
End Sub

 

[VenA]

Ik krijg een msgbox te zien waarbij ik op "OK" kan klikken, maar er gebeurd niets wanneer ik hierop klik.

Niet alle code wordt panklaar aangeleverd en dat mag je dan ook zelf inpassen? Een msgbox heeft als doel om te zien of je bij een bepaalde code het juiste te zien krijgt. Dat er verder niets gebeurt lijkt mij dan ook niet meer dan logisch.

Even toegepast geeft volgens mij het juiste resultaat.

Sub VenA()
Application.ScreenUpdating = False
Select Case [M2].End(xlToLeft).Column
    Case 1
        If [A2] = "" Then f = "KCF" & Year(Date) & "01" Else f = "KCF" & Year(Date) & "02"
    Case 11
        f = "KCF" & Year(Date) - 1 & "12"
    Case Else
        f = "KCF" & Year(Date) & Format(Month(Date) - 1, "00")
End Select

Workbooks.Open "C:\temp\" & f & ".xlsx"
ar = Cells(1).CurrentRegion
ActiveWorkbook.Close
ReDim ar1(775)
For j = 1 To UBound(ar)
    If ar(j, 4) = "S41" Then
        For jj = 5 To UBound(ar, 2)
            If ar(j, jj) <> "" Then
                ar1(t) = ar(j, jj)
                t = t + 1
            End If
        Next jj
    End If
Next j
Sheets("Blad1").Cells(2, Val(Mid(ar(9, 1), 3, 2))).Resize(776) = Application.Transpose(ar1)
End Sub