Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
Copy and Paste distinct columns macro
Here is the barebones version...
Clear Sheet2 then look for a number in A1 on Sheet1 Then for columns 1 - to the number in A1 look for 1 in row 2 of the column If found copy the entire column to the next available column in Sheet2, starting from Col A ' Sub copyCol() Dim nCols As Long Dim i, j As Long nCols = Range("A1") j = 1 Worksheets("Sheet2").UsedRange.ClearContents For i = 1 To nCols If Cells(2, i) = 1 Then Columns(i).EntireColumn.Copy _ Destination:=Worksheets("Sheet2").Cells(1, j) j = j + 1 End If Next End Sub "mopgcw" wrote: 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 |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
Copy and Paste distinct columns macro
THANKS! This was very helpful.
Take Care, George "Sheeloo" wrote: Here is the barebones version... Clear Sheet2 then look for a number in A1 on Sheet1 Then for columns 1 - to the number in A1 look for 1 in row 2 of the column If found copy the entire column to the next available column in Sheet2, starting from Col A ' Sub copyCol() Dim nCols As Long Dim i, j As Long nCols = Range("A1") j = 1 Worksheets("Sheet2").UsedRange.ClearContents For i = 1 To nCols If Cells(2, i) = 1 Then Columns(i).EntireColumn.Copy _ Destination:=Worksheets("Sheet2").Cells(1, j) j = j + 1 End If Next End Sub "mopgcw" wrote: 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Summing distinct columns | Excel Worksheet Functions | |||
Copy to Clipboard - Distinct List | Excel Discussion (Misc queries) | |||
copy and paste visible columns | Excel Discussion (Misc queries) | |||
Why can't a copy and paste columns? | Excel Worksheet Functions | |||
Copy/Paste of separated columns | Excel Discussion (Misc queries) |