Copy and paste to last row

[excel_beginer]

Hi all

I have file want to copy data from 3 sheets to one, data need copy from range (B2:I) to lastrow of each sheet

Finally sumtotal from lastrow from 3 sheet in lastrow of this sheets

I coding like belove but not work, please help me

Sub PL3PL7()Dim lastRow1 As Long, lastRowPL3BC As Long, lastRowPL7BC As Long, lastRowPL7BCTCVM As Long, cel As Range
lastrowPL3BC = Sheets("PL3BC").Cells(Rows.Count, 3).End(xlUp).Row
lastrowPL7BC = Sheets("PL7BC").Cells(Rows.Count, 3).End(xlUp).Row
lastrowPL7BCTCVM = Sheets("PL7BCTCVM").Cells(Rows.Count, 3).End(xlUp).Row
lastrow1 = Sheets("phantich").Cells(Rows.Count, 3).End(xlUp).Row
With Sheets("phantich")
.Range("A5:I" & lastrow1).ClearContents
Sheets("PL3BC").Range("B2:I" & lastrowPL3BC).Copy
.Range("B6").PasteSpecial xlPasteValues
Sheets("PL7BC").Range("B2:I" & lastrowPL7BC).Copy Destination:=.Cells(lastrow1 + 1, "B")
Sheets("PL7BCTCVM").Range("B2:I" & lastrowPL7BCTCVM).Copy Destination:=.Cells(lastrow1 + 1, "B")

.Range("D1").Offset(lastRow1).Value = Sheets("PL3BC").Range("D" & lastrowPL3BC).Value + Sheets("PL7BC").Range("D" & lastrowPL7BC).Value + Sheets("PL7BC").Range("D" & lastrowPL7BCTCVM).Value
End With
End Sub

 

[mumps]

Re: Help to copy and paste to last row

Try:

Sub PL3PL7()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, LastRow1 As Long, LastRow2 As Long, desWs As Worksheet, total As Long
    Set desWs = Sheets("phantich")
    LastRow2 = desWs.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each ws In Sheets(Array("PL3BC", "PL7BC", "PL7BCTCVM"))
        total = total + ws.Range("D" & ws.Range("D" & ws.Rows.Count).End(xlUp).Row).Value
        LastRow1 = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        If LastRow2 < 6 Then
            LastRow2 = 6
            ws.Range("A5:I" & LastRow1).Copy desWs.Range("B" & LastRow2)
        Else
            ws.Range("A5:I" & LastRow1).Copy desWs.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
        End If
    Next ws
    desWs.Cells(Rows.Count, "D").End(xlUp).Offset(1, 0) = total
    Application.ScreenUpdating = True
End Sub

 

[excel_beginer]

Re: Help to copy and paste to last row

Thanks @Mum but code only copy lastrow of each sheet then total from each one. No copy another row above.

Note that my data form each sheet from row 2, row 1 is blank

 

[mumps]

Re: Help to copy and paste to last row

Can you post a screen shot of what your source sheet data looks like? Section B at this link has instructions on how to post a screen shot: https://www.mrexcel.com/forum/board-announcements/127080-guidelines-forum-use.html Alternately, you could upload a copy of one of your source files to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells, rows, columns and worksheets. If the workbook contains confidential information, you could replace it with generic data.

 

[excel_beginer]

Re: Help to copy and paste to last row

Yes, this's my file.
Please help me

 

[mumps]

Re: Help to copy and paste to last row

Try:

Sub PL3PL7()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, LastRow1 As Long, LastRow2 As Long, desWs As Worksheet, total As Long
    Set desWs = Sheets("phantich")
    LastRow2 = desWs.Range("A" & desWs.Rows.Count).End(xlUp).Row
    For Each ws In Sheets(Array("PL3BC", "PL7BC", "PL7BCTCVM"))
        total = total + ws.Range("D" & ws.Range("D" & ws.Rows.Count).End(xlUp).Row).Value
        LastRow1 = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        If LastRow2 < 6 Then
            LastRow2 = 6
            ws.Range("A2:I" & LastRow1 - 1).Copy
            desWs.Range("B" & LastRow2).PasteSpecial xlPasteValues
        Else
            ws.Range("A2:I" & LastRow1 - 1).Copy
            desWs.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next ws
    desWs.Cells(Rows.Count, "D").End(xlUp).Offset(1, 0) = total
    Application.ScreenUpdating = True
End Sub

 

[excel_beginer]

Re: Help to copy and paste to last row

Thanks @mumps, code work but only total in column D, is there any way to total Column D to I?

 

[mumps]

Re: Help to copy and paste to last row

Try:

Sub PL3PL7()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, LastRow1 As Long, LastRow2 As Long, desWs As Worksheet, x As Long
    Set desWs = Sheets("phantich")
    LastRow2 = desWs.Range("A" & desWs.Rows.Count).End(xlUp).Row
    For Each ws In Sheets(Array("PL3BC", "PL7BC", "PL7BCTCVM"))
        LastRow1 = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        If LastRow2 < 6 Then
            LastRow2 = 6
            ws.Range("A2:I" & LastRow1 - 1).Copy
            desWs.Range("B" & LastRow2).PasteSpecial xlPasteValues
        Else
            ws.Range("A2:I" & LastRow1 - 1).Copy
            desWs.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next ws
    LastRow2 = desWs.Range("B" & desWs.Rows.Count).End(xlUp).Row
    For x = 5 To 10
        desWs.Cells(LastRow2 + 1, x) = WorksheetFunction.Sum(desWs.Range(desWs.Cells(6, x), desWs.Cells(LastRow2, x)))
    Next x
    Application.ScreenUpdating = True
End Sub

 

[excel_beginer]

Re: Help to copy and paste to last row

Many thanks @mumps

 

[mumps]

Re: Help to copy and paste to last row

You are very welcome.