Copy CSV list of columns to new workbook 2

[VBAjedi]

Anybody have (or care to bang out) a tidy code snippet for a function that copies a CSV list of columns from the active sheet into a new workbook? It would be used something like this:

ColList = "A, C, E, F, C"
Result = CopyCols(ColList)

. . . which would write the values in those columns to a new workbook in columns A-E (I don't really care what the function returns - a Boolean flag or a pathname would be fine). Note that the columns are not necessarily in order, and that they may appear more than once. And yes, I realize that this will cause problems for columns containing formulas. I just want the cell values.

Thanks for any input! All my ideas so far have been kludgy and not worth attempting. . .

VBAjedi

 

[SkipVought]

hey VBA,

Try this

    Set wsThis = ActiveSheet
    Set wsNew = Workbooks("Whatever.xls").Worksheets("Sheet3")
    For i = LBound(ColList, 1) To UBound(ColList, 1)
        wsThis.Columns(ColList(i)).Copy Destination:=wsNew.Cells(1, ColList(i))
    Next

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[VBAjedi]

Yo, Skip!

Looked promising, so I built on it. I had to add code to load my string into an array. The following code does what I want EXCEPT when the source column contains a multicolumn merged range (ex. trying to copy Column "A:A" when cells "A3:B3" are merged). Any ideas?

Sub Test1()
Dim sh As Worksheet
Dim x As String
x = "A, B:B,D, F, K,H,"
y = CopyCols(x, ActiveSheet)

End Sub


Function CopyCols(ColList As String, SourceSheet As Worksheet)
Dim ColArray() As String
Dim x, y, z, a ' utility variables
ReDim ColArray(100) ' Allows up to 100 columns to be copied
y = 1
z = 0
For x = 1 To Len(ColList)
   a = Mid(ColList, x, 1)
   If a <> &quot;,&quot; And x = Len(ColList) Then x = x + 1 ' adjust for last column in list
   If a = &quot;,&quot; Or x > Len(ColList) Then
      z = z + 1
      ColArray(z) = Trim(Mid(ColList, y, (x - y)))
      If InStr(1, ColArray(z), &quot;:&quot;) < 1 Then ' Is a single-column reference
         ColArray(z) = ColArray(z) & &quot;:&quot; & ColArray(z) ' change form &quot;A&quot; to &quot;A:A&quot;
      End If
      y = x + 1
   End If
Next x

ReDim Preserve ColArray(z) '
Set wsThis = SourceSheet
Set wbNew = Workbooks.Add
Set wsNew = wbNew.Worksheets(1)
For i = 1 To UBound(ColArray, 1)
   wsThis.Columns(ColArray(i)).Copy Destination:=wsNew.Cells(1, i)
Next
CopyCols = wbNew
End Function

Thanks!

VBAjedi

 

[xlbo]

All copy functions fall over on merged cells - they are the evil emperor of excel - don't use 'em

Use format>Alignment Centre Across Selection instead - looks the same but doesn't mess up range like merge does...

Rgds, Geoff
[blue]Si hoc signum legere potes, operis boni in rebus Latinus alacribus et fructuosis potiri potes![/blue]
Want the [red]best[/red] answers to your questions ? faq222-2244

 

[shaddow]

You could use the Range method instead of Columns it will work 100%.
My C column had a merge from C24, and if i copied D column also it wont get the merged value. just empty as it should be.
maxRowSize reprezents how many lines will copy from that column since if you use the Columns instead of Range it wont work. You can set it to max size wich is 65535 and should work ok. It takes values from Sheet1 and sends to Sheet2 in order including the merged cell,

    Dim colNames
    Dim maxRowSize 'the number of maximum rows that will be copied
    maxRowSize = 1000
    colNames = Array("A", "E", "AA", "C")
    destCol = 1
    
    For Each col In colNames
        Sheet1.Range(col & "1", col & maxRowSize).Copy Sheet2.Cells(1, destCol)
        destCol = destCol + 1
    Next col

________
George, M

 

[xlbo]

so it does - very nice. Still shouldn't use merged cells though ;-)

Rgds, Geoff
[blue]Si hoc signum legere potes, operis boni in rebus Latinus alacribus et fructuosis potiri potes![/blue]
Want the [red]best[/red] answers to your questions ? faq222-2244

 

[VBAjedi]

Geoff - if merged cells are the "Evil Emperor" of Excel, then some of my spreadsheets are in grave danger of giving in to the Dark Side (and I call myself a Jedi!). . . But why in the FREAKIN' HECK have I never seen or been shown "Center Across Selection" before? I've spent huge amounts of time in the past creating workarounds to the problems caused by the "necessity" of merged cells. That info solves my current challenge and is worth a FAT star!

shaddow - nice bit of code there. If, for some reason, I run into a situation where "Center Across Selection" doesn't work for me, I'll use your code. Have a star!

Thanks to both of you for your input!


VBAjedi

 

[xlbo]

dunno - I only found it not too long ago when I was looking for a way round merging cells - funnily enough 'cos they were giving me grief when I was trying to copy from them or into them.....

Rgds, Geoff
[blue]Si hoc signum legere potes, operis boni in rebus Latinus alacribus et fructuosis potiri potes![/blue]
Want the [red]best[/red] answers to your questions ? faq222-2244