Скопировать вниз в столбце

Question

У меня проблема с частью более крупного макроса VBA, поэтому нет;Я не могу сделать это по-другому.

Я хочу скопировать значение вниз в пустой столбец, но только в столько строк, сколько у меня есть на листе.

Я хочу, чтобы оно автоматическипосчитайте, сколько строк активно на рабочем листе и эта строка является последней, но я застрял и не хочу делать так, как хочу.

Ниже приведен код, с которым я работаю.

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

Мои данные выглядят так (я не нашел, как прикрепить)

     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

И я хочу заполнить ячейку B3: B9 SE, но не так, чтобы это былоB3: B4 или B3: B15, поэтому он должен быть гибким.

Спасибо

Answer 1

Одна небольшая поправка к решению QHarr:

При вставке значений вы должны либо принудительно форсировать worksheet.calculate, либо использовать формулу VBA.Если нет, вы получите пробелы, если используется настройка ручного пересчета.Например

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

Answer 2

Найдите последнюю заполненную строку столбца A, поднявшись снизу листа, и используйте его для столбца B в поле «Заполнить».Я использовал Right $ вместо вашего Mid.Вы также можете использовать Mid $ (. Range ("A1"). Value, 11, 2).Шаги формулы не нужны и могут быть удалены.

Измените имя листа на соответствующее имя листа.

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

---

Вы можете упростить, мое предпочтение, следующее:

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