Копирование диапазона переменных на основе непустых текстовых полей

В worksheet1 («добавить») у меня есть таблица от A4 до Z14. Он используется для отображения рейса корабля с различными портами и автоматически рассчитывает время и дату. Я хочу скопировать эту таблицу (этот конкретный рейс) на другой рабочий лист2 («расписание») с полным маршрутом судна. Для этого я копирую диапазон в буфер обмена с помощью VBA. (Я запускаю с ним некоторые другие макросы, но объяснение становится несколько сложным.)

Моя проблема: я хочу скопировать только диапазон, содержащий вызовы портов. Порты вводятся в столбце C, поэтому диапазон от C4 до C14. Таким образом, если в рейсе только три порта, с C4 по C6 содержатся имена портов, а с C7 по C14 пусты или равны 0. Скопированный диапазон должен быть A4:Z6. Если есть пять портов, диапазон должен быть A4:Z8.

Так как для некоторых ячеек нужно скопировать формулы, а для некоторых только значения (которые приходят из общего листа ввода), я сначала вставил полный диапазон, а затем скопировал/вставил значения диапазонов поверх него, чтобы разорвать связь с общий вводной лист.

Dim myC As Range
Set myC = ActiveCell
Application.CutCopyMode = False
          'insert 
Sheets("Add").Select
Rows("5:14").Select
Selection.COPY
Sheets("Schedule").Select
myC.Select
ActiveCell.Offset(1, 0).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False

'paste values voy#/ports            
Sheets("Add").Select
Application.CutCopyMode = False
Range("B5:C14").Select
Selection.COPY
Sheets("Schedule").Select
myC.Select
ActiveCell.Offset(1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues,Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

--> повторяет вставляемые значения для диапазонов E5:J14, M5:R14, T5:T14, AB5:AG14

номер строки диапазонов должен зависеть от последней строки со значением в ней в диапазоне C4:C14

Я просмотрел множество разных проблем/ответов, но все они немного отличаются от моих.


conditional-statements excel range vba copying
person Richard    schedule 05.01.2015    source источник
comment
Пожалуйста, поделитесь кодом, над которым вы работали до сих пор.   -  person bp_    schedule 05.01.2015
comment
пожалуйста, найдите код в исправленном вопросе   -  person Richard    schedule 08.01.2015

Ответы (1)


arrow_upward
0
arrow_downward

Возможно, вам придется изменить место его вставки на листе расписания, поскольку я не знаю, где находится ActiveCell... но это должно сработать.

Dim lngRowSearch As Long
lngRowSearch = 3
With Sheets("Add")
    Do
        lngRowSearch = lngRowSearch + 1
    Loop Until .Cells(lngRowSearch + 1, 3) = 0
    .Range("A4:Z" & lngRowSearch).Copy
End With
Sheets("Schedule").Cells(1, 1).PasteSpecial xlPasteValues
person bp_    schedule 09.01.2015
comment
Большой! большое спасибо! Мне удалось установить его без особых проблем, и он работает так, как я надеялся. - person Richard; 12.01.2015