I'm not completely sure what you want to do, this function will copy the selected columns from the source worksheet to the destination worksheet, if there are any values in them. Paste this code in a new module:
Public Sub btnCopyNonBlank_Click()
Dim strCols As String
Dim arrCols(1 To 4) As Integer
arrCols(1) = 1
arrCols(2) = 3
arrCols(3) = 5
arrCols(4) = 7
Call CopyNonBlank(Worksheets("Sheet1"), arrCols, Worksheets("Sheet2"))
strCols = "1,3,5,7"
Call CopyNonBlank(Worksheets("Sheet1"), strCols, Worksheets("Sheet2"))
End Sub
Public Sub CopyNonBlank(ByVal wksSource As Worksheet, ByVal arrColsIn As Variant, ByVal wksDest As Worksheet)
Dim arrData As Variant
Dim arrCols() As Integer
Dim intPos As Integer
Dim intPosLast As Integer
Dim intMaxCol As Integer
Dim lngLastRow As Long
Dim intCol As Integer
Dim lngCurrRow As Long
Dim intDestCol As Integer
If TypeName(arrColsIn) = "String" Then
intPosLast = 0
intMaxCol = 0
ReDim arrCols(1 To 1)
Do
intPos = InStr(intPosLast + 1, arrColsIn, ",")
If intPos > 0 Then
arrCols(UBound(arrCols)) = Mid(arrColsIn, intPosLast + 1, intPos - intPosLast - 1)
ReDim Preserve arrCols(1 To UBound(arrCols) + 1)
Else
arrCols(UBound(arrCols)) = Mid(arrColsIn, intPosLast + 1)
End If
If arrCols(UBound(arrCols)) > intMaxCol Then
intMaxCol = arrCols(UBound(arrCols))
End If
intPosLast = intPos
Loop While intPos > 0
Else
ReDim arrCols(LBound(arrColsIn) To UBound(arrColsIn))
For intPos = LBound(arrColsIn) To UBound(arrColsIn)
arrCols(intPos) = arrColsIn(intPos)
Next intPos
End If
lngLastRow = wksSource.Cells.Find(What:="*", After:=[A1], _
SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
arrData = wksSource.Cells(1, 1).Resize(lngLastRow - 1, intMaxCol).Formula
intDestCol = 0
For intCol = LBound(arrCols) To UBound(arrCols)
For lngCurrRow = LBound(arrData) To UBound(arrData)
If arrData(lngCurrRow, intCol) > "" Then
intDestCol = intDestCol + 1
wksSource.Columns(arrCols(intCol)).Copy
wksDest.Cells(1, intDestCol).PasteSpecial xlValues
Exit For
End If
Next lngCurrRow
Next intCol
Application.CutCopyMode = False
End Sub
and put a button on your source sheet, have it call btnCopyNonBlank_Click. I put two versions of the calling routine in, one for using an array of the columns, the second a string with the columns. You can just delete the one you don't want.
The btnCopyNonBlank_Click function sets up the variables for the CopyNonBlank function. CopyNonBlank first sets up an array holding the desired column numbers, put the entire source sheet into an array, then loops through each of the columns looking for data. If it finds data in the column, then it copies the entire column to the next column in the destination worksheet.
Let me know if this works for you, or if you need some tweaks.