# Find Col and Paste...

#### m0atz

##### Board Regular
Hi all,

I have minor prob which I'm sure will be an easy fix...

Currently there are 3 sheets in my wbook, however there are likely to be 30 or so soon enough. Each sheet has loads of Cols of data and no sheet is generally the same.

I'm after my "Control" sheet to display a replica of the columns entitled "Destination" found in all other wsheets. i.e. each sheet has a destination col and I need an automated way of getting these lists side by side.

The challenge I'm faced with is that the destination col in each sheet is never usually in the same column, i.e. sheet1 could be colA, sheet2 colB etc and each sheet might contain more than one destination col,

Can anyone help?

cheers

colin

### Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.

#### pbornemeier

##### Well-known Member
This code puts the sheet name in row 1 and the column number in row 2 then copies the first 65533 lines of that column to row 3 and below on the control worksheet.

EXISITNG DATA ON CONTROL WORKSHEET WILL BE ERASED WHEN THIS CODE IS RUN

Code:
``````Sub CopyDestinationColumns()
Dim intX As Integer
Dim intY As Integer
Dim intColumn As Integer
Dim intDestinationCount As Integer
Dim intControlColumnToWrite As Integer
Dim cFind

Worksheets("Control").Cells.Clear
intControlColumnToWrite = 1
For intX = 1 To Worksheets.Count
Worksheets(intX).Select
If Worksheets(intX).Name <> "Control" Then
With Worksheets(intX).Rows(1)
intDestinationCount = Application.WorksheetFunction.CountIf(Rows(1), "Destination")
Set cFind = .Find("Destination", after:=Cells(1, 256))
intY = 0
Do While Not cFind Is Nothing
Worksheets("Control").Cells(1, intControlColumnToWrite) = Worksheets(intX).Name
Worksheets("Control").Cells(2, intControlColumnToWrite) = cFind.Column
Worksheets(intX).Range(Cells(1, cFind.Column), Cells(65533, cFind.Column)).Copy _
Destination:=Worksheets("Control").Cells(3, intControlColumnToWrite)
intControlColumnToWrite = intControlColumnToWrite + 1
Set cFind = .FindNext(cFind)
intY = intY + 1
If intY = intDestinationCount Then Exit Do
Loop
End With
End If
Next

Worksheets("Control").Select
Cells.Columns.AutoFit
Range("A1").Select
End Sub``````

#### m0atz

##### Board Regular
Phil,

i can't thank you enough - that works perfectly..!

Col

#### m0atz

##### Board Regular
Perhaps i spoke too soon...for some reason I'm getting "Subscript Out of Range" when i add this macro to my personal.xls code. I can't work out what reference its not picking up (all my workbooks i create have a worksheet called control??)

Cheers

col

#### pbornemeier

##### Well-known Member
I copied my original code to my personal.xls and it ran as expected. The only time I got a "Subscript out of Range" error was when there was no 'Control' worksheet in the workbook. Here is a version with a check for the 'Control' worksheet.

Code:
``````Sub CopyDestinationColumns()
Dim intX As Integer
Dim intY As Integer
Dim intColumn As Integer
Dim intDestinationCount As Integer
Dim intControlColumnToWrite As Integer
Dim cFind
Dim booFound As Boolean

booFound = False
For intX = 1 To Worksheets.Count
If UCase(Worksheets(intX).Name) = "CONTROL" Then
booFound = True
Exit For
End If
Next

If booFound = True Then
Worksheets("Control").Cells.Clear
intControlColumnToWrite = 1
For intX = 1 To Worksheets.Count
Worksheets(intX).Select
If Worksheets(intX).Name <> "Control" Then
With Worksheets(intX).Rows(1)
intDestinationCount = Application.WorksheetFunction.CountIf(Rows(1), "Destination")
Set cFind = .Find("Destination", after:=Cells(1, 256))
intY = 0
Do While Not cFind Is Nothing
Worksheets("Control").Cells(1, intControlColumnToWrite) = Worksheets(intX).Name
Worksheets("Control").Cells(2, intControlColumnToWrite) = cFind.Column
Worksheets(intX).Range(Cells(1, cFind.Column), Cells(65533, cFind.Column)).Copy _
Destination:=Worksheets("Control").Cells(3, intControlColumnToWrite)
intControlColumnToWrite = intControlColumnToWrite + 1
Set cFind = .FindNext(cFind)
intY = intY + 1
If intY = intDestinationCount Then Exit Do
Loop
End With
End If
Next

Worksheets("Control").Select
Cells.Columns.AutoFit
Range("A1").Select
Else
MsgBox "No 'Control' worksheet"
End If
End_Sub:
Set cFind = Nothing

End Sub``````

#### m0atz

##### Board Regular
This is really weird - the new code says no control worksheet - but there's definitely a sheet there called Control - ! I'm not being thick am i, the sheet doesnt have to be in the personal.xls?

#### pbornemeier

##### Well-known Member
No, the 'Control' worksheet should be in the Active Workbook. Verify that 'Control' is spelled correctly on worksheet tab, with no punctuation or leading or trailing spaces and that it is not set to hidden or very hidden in its properties in VBA window (F4 when sheet is selected in VBAProject window).

Try
Code:
``````?Activeworkbook.Name  '1
Worksheets("Control").Select  '2``````
commands in the Immediate window and see if 1) displays the expected workbook name and 2) selects the expected worksheet

#### m0atz

##### Board Regular
I'm afraid to report I'm still having issues with this...

I created a quick sub as suggested,

Code:
``````sub test()

msgbox activeworkbook.name
worksheets("Control").select

end sub``````

and that works fine - it selects the Control sheet - there's definitely no hidden or very hidden properties (in fact its a brand new wbook I've created to try this out).

The code you posted works fine when its in the wbook code window, just not when in the personal.xls - this is so bizarre...!

#### pbornemeier

##### Well-known Member
The code should be in a module in the personal.xls file, I apologize for not mentioning it earlier. If it is in the personal.xls ThisWorkbook code page it will not work, since code in that module is not "aware" of code outside of personal.xls unless it is explicitly defined.

#### m0atz

##### Board Regular
I still get the same message - argh!!

Replies
1
Views
552
Replies
2
Views
228
Replies
0
Views
306
Replies
1
Views
476
Replies
0
Views
327

1,195,834
Messages
6,011,866
Members
441,651
Latest member
drewe2000

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back