Code to loop through columns for specific value range - vba

Question

Hi there I want a code which allows to loop through the columns of Sheet A, and columns which have values>0 would be copied to Sheet B. Did a code with help of some answers from the previous forum question but still having issues as it does not seem to work at the paste destination! Some help would be very much appreciated. The code is as follows:
Sub TestPasteColumnData3()
Dim lastcol As Long
Dim j As Long
With Worksheets("WF - L12 (3)")
lastcol = .Cells(4, Columns.Count).End(xlToLeft).Column
For j = 3 To lastcol
If CBool(Application.CountIfs(.Columns(j), ">0")) Then
.Columns(j).Copy Destination:=Worksheets("Sheet1").Columns(3)
Else
MsgBox ("No Value")
Exit Sub
End If
Next
End With
MsgBox ("Done")
End Sub

Answer 1

You keep pasting to column 3. Try:
.Columns(j).Copy Destination:=Worksheets("Sheet1").Columns(j)

Answer 2

Sub TestPasteColumnData3()
Dim lastcol As Long
Dim j As Long
With Worksheets("WF - L12 (3)")
lastcol = .Cells(4, Columns.Count).End(xlToLeft).Column
For j = 3 To lastcol
'change >0 to <>0 and 3 to j
If CBool(Application.CountIfs(.Columns(j), "<>0")) Then
.Columns(j).Copy Destination:=Worksheets("Sheet1").Columns(j)
Else
MsgBox ("No Value")
Exit Sub
End If
Next
End With
MsgBox ("Done")
End Sub
Pl make 2 changes suggested above your code will work.
#Niva I am yet to find out basic reason of Countifs or CountA not giving desired results. For your immediate requirements you can use an additional program to delete blanks in Sheet1. Please make it Active Sheet and use the following program.
Sub DeleteBlankColumns()
With Worksheets("Sheet1")
Dim lastColumn As Long
lastColumn = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
'MsgBox lastColumn
Dim lastRow As Long
Dim rng As Range
Set rng = ActiveSheet.Cells
lastRow = rng.Find(What:="*", After:=rng.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
'MsgBox lastRow
'Step1: Declare your variables.
Dim MyRange As Range
Dim iCounter As Long
'Step 2: Define the target Range.
Set MyRange = ActiveSheet.Range(Cells(1, 1), Cells(lastRow, lastColumn))
'Step 3: Start reverse looping through the range.
For iCounter = MyRange.Columns.Count To 1 Step -1
'Debug.Print iCounter
'Step 4: If entire column is empty then delete it.
Debug.Print Application.CountA(Columns(iCounter).EntireColumn) = 0
If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then
Columns(iCounter).Delete
End If
'Step 5: Increment the counter down
Next iCounter
End With
End Sub

Answer 3

Why use copy and paste? I try to avoid copy and paste because it relies on the OS's clipboard which can be used by other applications.
Worksheets("Sheet1").Columns(j).value = Columns(j).value
also this:
Application.CountIfs
should be this:
Application.worksheetfunction.CountIf 'Note, don't need countifS for only 1 criteria
Also, not sure that you really need to convert it to a boolean.