How to use/insert Len function in order to copy/paste only non empty cells?

dilshod_k

Board Regular
Joined
Feb 13, 2018
Messages
79
Hello everyone,

I tried to use Len function but I failed to debug code.
The aim is:
1. To create MasterSheet with 1st row same as 1st row of the source sheets (1st row in all sheets is identical)
2. To copy data from multiple sheets to the MasterSheet only those rows in which at least one cell in one the columns K, L, and M has value
and omit rows with all three cells in columns K,L,M empty

I would be grateful for suggestions to solve the problem.
My code is as it follows below:

Code:
Sub CopyRangeFromMultiWorksheets()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    ' Delete the summary sheet if it exists.
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("MasterSheet").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True


    ' Add a new summary worksheet.
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "MasterSheet"
    Sheets("Mastersheet").Move Before:=Sheets(1)


    ' Loop through all worksheets and copy the data to the
    ' summary worksheet.
    For Each sh In ActiveWorkbook.Worksheets
        'If sh.Name <> DestSh.Name Then
        
        If sh.Name <> DestSh.Name And sh.Name <> "Test1" And sh.Name <> "Test2" Then
       
            ' Find the last row with data on the summary worksheet.
            Last = LastRow(DestSh)


            ' Specify the range to place the data.
            Set CopyRng = sh.Rows("1")
            Set CopyRng = sh.Rows("2")
            
            ' Test to see whether there are enough rows in the summary
            ' worksheet to copy all the data.
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the " & _
                   "summary worksheet to place the data."
                GoTo ExitTheSub
            End If


            ' This statement copies values and formats from each
            ' worksheet.
            CopyRng.Copy
            With DestSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With


            ' Optional: This statement will copy the sheet
            ' name in the H column.
            DestSh.Cells(Last + 1, "N").Resize(CopyRng.Rows.Count).Value = sh.Name


        End If
    Next


ExitTheSub:


    Application.Goto DestSh.Cells(1)


    ' AutoFit the column width in the summary sheet.
    DestSh.Columns.AutoFit


    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub
 
Last edited by a moderator:

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.

Forum statistics

Threads
1,223,243
Messages
6,170,964
Members
452,371
Latest member
Frana

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top