CODEWITHSUNDEEP
excelvba
reinsermat
reinsermat

Reputation: 1

Copy between sheets and paste last row will overwrite values if column A (or B; C etc.) is empty

I would like to copy range of cells from sheet1 and paste to sheet2 into last row by using macro. Problem is, that if in sheet2 column A (or B; C) is empty, then last action (paste) will overwrite the last row in destination (sheet2)

Just can't get it correct. 

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

Upvotes: 0

Views: 75

Answers (1)

SJR
SJR

Reputation: 23081

This should work. Just base the last row on the column being copied, which I think is what you are doing. I assume the columns are of different lengths, otherwise you wouldn't need a loop at all.

You could also use Offset rather than Choose - would shorten the code a little.

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

Upvotes: 0

Related Questions