Autofill colum with a series starting from 1, until a given condition

[taatos]

Hi there!

I need to autofill a colum (A) with a series starting from 1, until in the next colum (B) is no data.
It must be a loop until ActiveCell.Offset(0,1) isEmpty

This is the file:

https://www.zeta-uploader.com/301295423

The sheet is "Borderou

 

[SkipVought]

Hi,

So what code do you have so far?

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[taatos]

I have allready attached the file on first thread.

 

[SkipVought]

Many of us cannot download data due to company security restrictions.

So if you want help, you need to post here.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[taatos]

This is the macro that copies the content to the sheet starting with the selected cell, and that is beeing looped until a given condition. This works, but I have to add the autofill to it

Sub Copy2borderou()
'
' Copy2borderou Macro
'
' Keyboard Shortcut: Ctrl+y
'
ActiveCell.Offset(0, -6).Range("A1:F1").Select
Selection.Copy
Sheets("Borderou").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
ActiveCell.Offset(1, 0).Range("A1").Select
Sheets("DB").Select
ActiveCell.Offset(0, 6).Range("A1").Select
End Sub

 

[taatos]

This is the condition I was telling about:

Sub CpySel2Borderou()
'
' ClearBorderou Macro
'
' Keyboard Shortcut: Ctrl+i
'
Range("K2").Select
Do Until IsEmpty(ActiveCell)
If ActiveCell.Text = "TRUE" Then
Application.Run "'MARELE TABEL.xlsm'!Copy2borderou"
Application.Run "'MARELE TABEL.xlsm'!SelBelow"
ElseIf ActiveCell.Text = "FALSE" Then
Application.Run "'MARELE TABEL.xlsm'!SelBelow"
End If
Loop
Sheets("Borderou").Select
End Sub

 

[SkipVought]

I advise against using the Select and Activate methods, but here's a solution using your code...

    Range("K2").Select
    Do Until IsEmpty(ActiveCell)
        If ActiveCell.Text = "TRUE" Then
            Application.Run "'MARELE TABEL.xlsm'!Copy2borderou"
            Application.Run "'MARELE TABEL.xlsm'!SelBelow"
        ElseIf ActiveCell.Text = "FALSE" Then
            Application.Run "'MARELE TABEL.xlsm'!SelBelow"
        End If[b]
        Activecell.offset(1).select[/b]
    Loop

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[taatos]

and what about the autofill with series?

 

[SkipVought]

Here's how I would do it.

dim r as range

for each r in range(cells(1,"B"),cells(1,"B").end(xldown))
   cells(r.row, "A").value = r.row
next

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]