Condition # Of Empty Cell in Column to COPY. How ?

FlaShow

New Member
Joined
Nov 23, 2020
Messages
10
Office Version
  1. 365
Platform
  1. Windows
Hello Friends,

I'm trying to COPY Columns from on Worksheet to a New Created One But would like to add a condition before the Actual Copy which is if the Column have more than 10 Empty Cells do not Copy this Column and Move to the next One to check So How i should organize my Code to do that.
VBA Code:
Dim wsCopy As Worksheet, wsDest As Worksheet
Dim CopyLastRow As Long, CopyLastColumn As Long

'Open Absent Sheet
    Workbooks.Open "C:\Users\Working\Desktop\absent11d7.xlsx"
    
'Set varialbe for copy and destination sheets
    Set wsCopy = Workbooks("absent11d7.xlsx").Worksheets(1)

'1. Find last used row in the copy range based on data in column A
    CopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, 1).End(xlUp).Row

'2. Fine last used column in copy range base
    CopyLastColumnNumber = wsCopy.Cells(1, Columns.Count).End(xlToLeft).Column
'Convert To Column Letter
    CopyLastColumnLetter = Split(Cells(1, CopyLastColumnNumber).Address, "$")(1)
    
    n = WorksheetFunction.CountA(Range("D2:D" & CopyLastRow))
    MsgBox "The number of non-blank cells in column is " & n
    
    'For i = 5 To 5
    'Set Rng = Intersect(Columns(i), ActiveSheet.UsedRange)
    'On Error Resume Next
    'b = Rng.Cells.SpecialCells(xlCellTypeBlanks).Count
    'n = Rng.Cells.Count - b
    'On Error GoTo 0
    'MsgBox "The number of non-blank cells in column " & Columns(i).Column & " is " & n
    'Next i
  
'Step 1 Copy the data
    wsCopy.Range("A1:" & CopyLastColumnLetter & CopyLastRow).Copy
'Step 2 Create a new workbook
    Workbooks.Add
'Step 3 Paste the data
    ActiveSheet.Paste Destination:=Range("A1")
'Step 4 Turn off application alerts
    Application.DisplayAlerts = False
'Step 5 Save the newly created workbook
    ActiveWorkbook.SaveAs _
    Filename:=ThisWorkbook.Path & "\NewAbsentData.xlsx"
'Step 6 Turn application alerts back on
    Application.DisplayAlerts = True
 

Some videos you may like

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

Watch MrExcel Video

Forum statistics

Threads
1,119,011
Messages
5,575,539
Members
412,674
Latest member
emeisee
Top