VBA copy column only when value is 1 in row 1

[NickvdB]

Hello,

Excel 2010:
I would like to use a VBA with the following code
Workbooks("AAA.xlsb").Worksheets("BBB").Range("VARIABLE").Copy Destination:=Workbooks("CCC.xlsb").Worksheets("BBB").Range("a1")
the red part should be based on the values of row 1. So as an example following cell values: A1=1 / B1=1 / D1=1 / G1=1
Then I would like to have rows A + B + D + G in the red part.
Hope this makes sense and somebody can help

 

[Arithos]

Hmm, abit unclear to me. Would you end result be like this?

Workbooks("AAA.xlsb").Worksheets("BBB").Range("ABCD").Copy

?

 

[NickvdB]

I have misused "rows" in the last sentence
In the example I would like to have the complete columns A, B, D and G copied, perhaps displayed as followed:
Workbooks("AAA.xlsb").Worksheets("BBB").Range("A:A"&"B:B"&"D:D"&"G:G").Copy

 

[Arithos]

soo. Range("A:D","G:G") basicly, and you want whatever Column who has the value 1 in the first row to be copied.. Let me draw something up

 

[NickvdB]

Perfect, thanks in advance!

 

[Arithos]

This is how I would do it, I look through row 1, for a value = 1, if that exists I move that column..

Sub sortTest()


LC = Workbooks("AAA.xlsb").Worksheets("BBB").Cells(1, Columns.Count).End(xlToLeft).Column


For i = 1 To LC
    If Cells(1, i).Value = 1 Then
        NC = Workbooks("AAA.xlsb").Worksheets("BBB").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Column
        Workbooks("CCC.xlsb").Worksheets("BBB").Columns(NC).Value = Workbooks("AAA.xlsb").Worksheets("BBB").Columns(i).Value
    End If
Next i
End Sub

It will not bring formats with it however, you could amend it like this to get that aswell.

Sub sortTest()


LC = Workbooks("AAA.xlsb").Worksheets("BBB").Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To LC
    If Cells(1, i).Value = 1 Then
        NC = Workbooks("AAA.xlsb").Worksheets("BBB").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Column
        Workbooks("AAA.xlsb").Worksheets("BBB").Columns(i).Copy Workbooks("CCC.xlsb").Worksheets("BBB").Columns(NC)
    End If
Next i
End Sub

Test them out, and let me know what you think. Both should be quick.

 

[NickvdB]

Thanks for the very quick solution, however excel is not happy with it VBA (your first solution) ran for minutes and I killed it.
Would it be more quicker to have the columns with value other than 1 removed?
For information the columns have somewhat like 1500 links to other files (already opened with VBA)

 

[Arithos]

Did you try debugging it? (running through it step by step).

so, basicly copy the sheet, then remove all columns without 1 in them? That could work.

 

[Arithos]

And, should not take that much time, how many columns will you have to move? You example listed 4. That should not take much time.

And I would suggest using my second solution if you want it to move links to other workbooks.

 

[Arithos]

What excel version are you using? 2003?