Копирование между листами и вставка последней строки приведет к перезаписи значений, если столбец A (или B; C et c.) Пуст. - PullRequest
0 голосов
/ 05 мая 2020

Я хотел бы скопировать диапазон ячеек из листа1 и вставить в лист2 в последнюю строку с помощью макроса. Проблема в том, что если на листе 2 столбец A (или B; C) пуст, то последнее действие (вставка) перезапишет последнюю строку в пункте назначения (sheet2)

Просто не могу понять это правильно.

Private Sub vaart_md_sis_Click()

Dim SourceWS As Worksheet, DestWS As Worksheet
Dim SourceRng As Range, DestCell As Range
Dim lloop As Long
Set SourceWS = Sheets("md") 
Set DestWS = Sheets("y_koond") 
Application.ScreenUpdating = 0
With SourceWS
Set DestCell = DestWS.Range("a" & Rows.Count).End(xlUp).Offset(1)
For lloop = 1 To 7
Set SourceRng = Choose(lloop, .Range("A3"), _
.Range("B3"), .Range("C3"), .Range("F3"), .Range("G3"), .Range("H3"), .Range("I3")) 
SourceRng.Copy
DestCell.Offset(, lloop - 1).PasteSpecial xlPasteValues
Next lloop
End With
With Application
.CutCopyMode = 0
.ScreenUpdating = 1
End With    
End Sub       

1 Ответ

0 голосов
/ 05 мая 2020

Это должно работать. Просто основывайте последнюю строку на копируемом столбце, что, я думаю, именно то, что вы делаете. Я предполагаю, что столбцы имеют разную длину, иначе вам вообще не понадобится al oop.

Вы также можете использовать Offset вместо Choose - это немного сократит код.

Private Sub vaart_md_sis_Click()

Dim SourceWS As Worksheet, DestWS As Worksheet
Dim SourceRng As Range, DestCell As Range
Dim lloop As Long

Set SourceWS = Sheets("md")
Set DestWS = Sheets("y_koond")

Application.ScreenUpdating = 0

With SourceWS
    For lloop = 1 To 7
        Set SourceRng = Choose(lloop, .Range("A3"), _
            .Range("B3"), .Range("C3"), .Range("F3"), .Range("G3"), .Range("H3"), .Range("I3"))
        Set DestCell = DestWS.Cells(Rows.Count, lloop).End(xlUp).Offset(1)
        SourceRng.Copy
        DestCell.PasteSpecial xlPasteValues
        'better to avoid copy/paste: destcell.value=sourcerng.value
    Next lloop
End With

With Application
    .CutCopyMode = 0
    .ScreenUpdating = 1
End With

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...