CODEWITHSUNDEEP
vbaexcelcopyrange
Akire
Akire

Reputation: 169

Copy down in column

I have a problem with a part of a bigger VBA Macro, so no; I can not do this another way.

I want to copy a value down in an empty column, but only in as many rows as I have in the worksheet.

I want it to automatically count how many rows that is active in the worksheet and that that row as the last one, but I get stuck and it does not want to do as I want.

Below is the code that I am working with.

Sub Coppy_down()
Range("B3").Formula = "=Mid(A1, 11, 2)"
Range("B3").Value = Range("B3").Value
Range("B3").Copy Range("B3", Range("B" & Rows.Count).End(xlUp))

End Sub

My data looks as this (I did not find how to attach)

     A             B
  1  District: SE   
  2  Date         District
  3  8/17/2018    
  4  8/24/2018  
  5  8/31/2018  
  6  9/7/2018   
  7  9/14/2018  
  8  9/21/2018  
  9  9/28/2018

And I want to fill cell B3:B9 with SE, but not that it might be B3:B4 or B3:B15, so it need to be flexible.

Thanks

Upvotes: 0

Views: 224

Answers (2)

OwlsSleeping
OwlsSleeping

Reputation: 1570

One slight amendment to QHarr's solution:

You should either force a worksheet.calculate or use a VBA formula when pasting values. If not you will get blanks if the manual recalculation setting is used. For example

Sub Coppy_down()
With Sheet1
.Range("B3", .Range("B" & .Cells(Rows.Count, "A").End(xlUp).Row)).Value = Mid(.Range("A1").Value, 11, 2)
End With
End Sub

Upvotes: 1

QHarr
QHarr

Reputation: 84465

Find the last populated row of column A, by coming up from the bottom of the sheet, and use that for column B in the "fill down". I have used Right$ in place of your Mid. You could also use Mid$(.Range("A1").Value, 11, 2). The formula steps are unnecessary and can be removed.

Change the sheet name to the appropriate sheet name.

Sub TEST()
    With ThisWorkbook.Worksheets("Sheet2")
        .Range("B3").Formula = "=RIGHT(A1,2)"
        .Range("B3").Value = .Range("B3").Value
        If .Cells(.Rows.Count, "A").End(xlUp).Row > 3 Then
            .Range("B4:B" & .Cells(.Rows.Count, "A").End(xlUp).Row) = .Range("B3")
        End If
    End With
End Sub

You could simplify, my preference, to:

Option Explicit
Public Sub TEST()
    With ThisWorkbook.Worksheets("Sheet2")
        If .Cells(.Rows.Count, "A").End(xlUp).Row >= 3 Then
            .Range("B3:B" & .Cells(.Rows.Count, "A").End(xlUp).Row) = Right$(.Range("A1"), 2)
        End If
    End With
End Sub

Upvotes: 2

Related Questions