loop in macro bouwen

[Emiel1975]

Hallo allemaal,

Ik heb de volgende macro gebouwd.
Maar nu wil ik dat een bepaald gedeelte (vanaf Set bereik t/m end with) in een loop komt totdat er geen gegevens meer in cellen zijn te vinden.
Deze stappen moet in sommige rapportages tot kolom FT lopen, het einde qua regels is variabel.


Rows("1:1").Select
Selection.Font.Bold = True
Columns("F:F").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.NumberFormat = "0.00"
Dim Bereik As Range

Set Bereik = Range(Range("f1"), Range("f65536").End(xlUp))
With Range("f65536").End(xlUp).Offset(2)
.Value = WorksheetFunction.Sum(Bereik)
.Font.Bold = True
.Font.ColorIndex = 3
.Font.TintAndShade = 0
End With

' Range("A1").Select
End Sub

Hopelijk kan iemand mij hierbij helpenBekijk bijlage test 1.xlsxBekijk bijlage test 1.xlsx

 

[VenA]

't is net of hetgeen je gebouwd hebt niet in de bijlagen staat.

 

[Emiel1975]

Bekijk bijlage test 1.xlsx

Vena,

Ik heb even de bijlage geupdate met een macro knop.
Hopelijk werkt dit iets beter.....en nog belangrijker dat jij mij kan helpen.

 

[VenA]

Had ik dit al geschreven?

't is net of hetgeen je gebouwd hebt niet in de bijlagen staat.

Een .xlsx bevat geen code...............

 

[Emiel1975]

Ik ben nog niet zo heel bekend met het aanleveren van bestanden.
En ik zie ook even niet wat ik verkeerd doe.
Maar ik heb de Code in mijn eerste bericht gezet.

Wat kan ik doen om het bestand beter aan te leveren

 

[VenA]

De code in jouw eerste bericht hoort tussen codetags

Een .xlsx kan geen code bevatten. Je zal een bestand met code op moeten slaan als .xlsm of .xlsb. Als dit soort basiskennis niet aanwezig is dan vraag ik mij af wat je met VBA wil?

Mogelijk dat dit het gewenste resultaat geeft.

Sub VenA()
lr = Sheets("Sheet1").Cells(Rows.Count, 4).End(3).Row
For j = 6 To 10
    Cells(lr + 1, j) = Application.Sum(Cells(2, j).Resize(lr))
Next j
End Sub

 

[Emiel1975]

Bedankt Vena,

Idd dat vraag ik mij nu ook af.....waarschijnlijk een brainfart......druk op het werk en doe dit even tussendoor.

Je code werkt goed, heb een hele kleine aanpassing gedaan.
Ik heb nu een bestand bijgesloten .xlsb (.xlsm ga een error message) waarbij meerdere kolommen zijn. Maar zie even niet in jou code waar ik er voor kan zorgen dat hij naar het eind gaat en de optelling incl opmaak voor alle kolommen maakt waar data instaat.

 

[HSV]

Sub hsv()
Dim j As Long
 For j = 6 To 10
  Sheets(1).Cells(Rows.Count, j).End(xlUp).Offset(2) = Application.Sum(Columns(j))
 Next j
End Sub

 

[Emiel1975]

Heren we zijn er bijna.

Ik heb twee opmerkingen nog, en vermoed dat dit makkelijk en snel op te lossen is.

Bekijk bijlage Macro test2.txt

 

[HSV]

We zitten in een Excel forum.
Wat moeten we met een .txt bestand.

 

[Emiel1975]

We zitten in een Excel forum.
Wat moeten we met een .txt bestand.

Daar staat de macro in.

Rows("1:1").Select
Selection.Font.Bold = True
Columns("F:F").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.NumberFormat = "0.00"
Dim Bereik As Range
Set Bereik = Range(Range("f1"), Range("f65536").End(xlUp))
lr = Sheets("Sheet1").Cells(Rows.Count, 4).End(3).Row
For j = 6 To 167
' For j = 6 To (deze moet stoppen wanneer er geen data in de kolom erboven staat)
Cells(lr + 2, j) = Application.Sum(Cells(2, j).Resize(lr))
Next j
' onderstaande opmaak moet gelden voor alle optellingen
With Range("f65536").End(xlUp).Offset(2)
.Font.Bold = True
.Font.ColorIndex = 3
.Font.TintAndShade = 0
End With
Range("A1").Select
End Sub

 

[HSV]

Graag je code selecteren en druk op #, dan staat dat tenminste in codetags.
Dan zie ik je opmerkingen ook beter.

Als je een .xlsb bestand had geplaatst met een apostrof voor je opmerkingen was het me vast beter opgevallen.

 

[Emiel1975]

Kijk dat is handige informatie.

Rows("1:1").Select
    Selection.Font.Bold = True
    Columns("F:F").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.NumberFormat = "0.00"
    Dim Bereik As Range
    Set Bereik = Range(Range("f1"), Range("f65536").End(xlUp))
    lr = Sheets("Sheet1").Cells(Rows.Count, 4).End(3).Row
    For j = 6 To 167
' For j = 6 To (deze moet stoppen wanneer er geen data in de kolom erboven staat)
    Cells(lr + 2, j) = Application.Sum(Cells(2, j).Resize(lr))
    Next j
' onderstaande opmaak moet gelden voor alle optellingen
    With Range("f65536").End(xlUp).Offset(2)
     .Font.Bold = True
     .Font.ColorIndex = 3
     .Font.TintAndShade = 0
   End With
  Range("A1").Select
End Sub

 

[HSV]

Sub hsv()
Dim j As Long
With Sheets(1)
 .Rows(1).Font.Bold = True
 .Columns(6).End(xlToRight).Resize(.Cells(Rows.Count, 6).End(xlUp).Row).NumberFormat = "0.00"
   For j = 6 To .Cells(1, Columns.Count).End(xlToLeft).Column
    With .Cells(Rows.Count, j).End(xlUp).Offset(2)
     .Value = Application.Sum(Columns(j))
     .Font.Bold = True
     .Font.ColorIndex = 3
    End With
   Next j
 End With
End Sub

 

[Emiel1975]

Bedankt HSV & VenA, het werkt.

Top bedankt en ik zal in het vervolg codes duidelijker weergeven en bestanden goed opslaan en uploaden