View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.misc
mopgcw mopgcw is offline
external usenet poster
 
Posts: 18
Default Copy and Paste distinct columns macro

Hey folks,

I need your help again. I have a data on Sheet1 such as:

A B C D E
1 1 2 3 4 5
2 1 0 1 1 0
3 D1 D2 D3 D4 D5
2 D6 D7 D8 D9 D10
3 D11....

Row 1 specifies the number of columns to include in the review = 5
Row 2 indicates whether to copy the column 1=yes; 0=no

So I need the macro to loop through the columns and copy Column A to the
specified range on Sheet 2; then Column C to the next open Column in Sheet 2,
the Column D etc...

here is the code I have so far:

Sub ColumnCopy()

' Initialize Variables

Dim TheRangeName As String
Dim ColLoop As Integer
Dim F As Integer
Dim TotNumCol As Integer
Dim ColIncluded As Integer

NumCols = WorksheetFunction.Max(Range("array_colnum").Value)

' Clear contents of the range where data will be pasted on sheet 2.

Range("Analysis_Range").ClearContents

TotNumCol = 0
ColIncluded = 0

' Loop through each column

Application.Goto Reference:=Range("col_id_start"), Scroll:=True

For ColLoop = 1 To NumCols

If Range("Array_ColInclude").Cells(ColLoop) = 1 Then

'========================================
'Copy & Paste each Column
'========================================

For F = 1 To 500

If Range("col_id_start").Cells(F).Value 0 Then

ColIncluded = ColIncluded + 1

Range(Selection, Selection.End(xlDown)).Select

ActiveWorkbook.Names.Add Name:="TheRangeName",
RefersTo:=Selection

Range(TheRangeName).Copy

Range("analysis_range").Cells(TotNumCol - ColIncluded +
1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False,
Transpose:=False

End If
Next F

End If

Next ColLoop

Range("A1").Copy ' JUST TO CLEAR CLIPBOARD
Application.CutCopyMode = False

Application.DisplayAlerts = True
MsgBox ("Copied " + WorksheetFunction.Text(ColIncluded, "0") + " Columns")

End Sub

The code is getting hung up on: "Range(TheRangeName).Copy"



TIA for your insights and assistance.

George