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.
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