• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copy specific columns from one sheet to another.

J

Jagdev Singh

Active Member
Hi Experts

I want to copy the specific columns from one sheet to another sheet. The below code is working fine, but the count of columns is more than 20. Using this code will be hectic. Could you please help me with the way I can copy the selected columns from one sheet to another.

Code: 
Sub CopyColumnByTitle()
'Find "Entity" in Row 1
  With Sheets("RAW_Client").Rows(1)
  Set t = .Find("Entity", lookat:=xlPart)
'If found, copy the column to Sheet 2, Column A
'If not found, present a message
    If Not t Is Nothing Then
        Columns(t.Column).EntireColumn.Copy _
          Destination:=Sheets("Client").Range("A1")
      Else: MsgBox "Name Not Found"
    End If
  End With
'Find "Department" in Row 1
  With Sheets("RAW_Client").Rows(1)
  Set t = .Find("Department", lookat:=xlPart)
'If found, copy the column to Sheet 2, Column A
'If not found, present a message
    If Not t Is Nothing Then
        Columns(t.Column).EntireColumn.Copy _
          Destination:=Sheets("Client").Range("B1")
      Else: MsgBox "Age Not Found"
    End If
  End With
End Sub
 
Can you elaborate on what you mean by 20 columns? Your current code only looks for 2 different items, and copies them. Do you mean that there will be multiple instances of "Entity", or do you have other words you need to search for?
 
Hi Luke

The above code is for 2 columns name which will copy them from a sheet to another. I have to perform same exercise for more than 20 columns. Using the same code will increase the length of the code to great expend. Is there any easy way to reduce the length of the code for more than 20 columns.

Regards
JD
 
Hi JD,

one option I think of is list all your 20 column names in one column in a separate sheet. Or even make an array, And use a for loop or while loop to search each of the word from that column. something like:

Code: 
Sub CopyColumnByTitle()
Dim SearchCols(20) As String
SearchCols(0) = "Entity"
SearchCols(1) = "Department"
SearchCols(2) = "NextColumnName"
'continue with all the column names
Dim i As Integer
'Find "Entity" in Row 1
 With Sheets("RAW_Client").Rows(1)
  For i = LBound(SearchCols) To UBound(SearchCols)
  Set t = .Find(SearchCols(i), lookat:=xlPart)
  'If found, copy the column to Sheet 2, Column A
  'If not found, present a message
  If Not t Is Nothing Then
  Columns(t.Column).EntireColumn.Copy _
  Destination:=Sheets("Client").Range("IV1").End(xlToLeft).Offset(0, 1)
  Else: MsgBox "Name Not Found"
  End If
  Next
 End With

Regards,
Prasad DN
 
Hi Prasad

The code is running fine. Could you please let me know why is it start pasting the data in column "B" in the client sheet instead of column "A".

Regards,
JD
 
The paste section is written to always do an offset, which is why it never pastes in col A. We can correct this by changing the last If block to:
Code: 
Dim pasteCol As Long
If Not t Is Nothing Then
    pasteCol = Sheets("Clients").Cells(1, .Columns.Count).End(xlToLeft).Column
    If pasteCol <> 1 Then pasteCol = pasteCol + 1
    Columns(t.Column).EntireColumn.Copy _
    Destination:=Sheets("Client").Cells(1, pasteCol)
Else
    MsgBox "Name Not Found"
End If
 
Hi Luke

The output of the above paste code is only the last Array value. I mean to say in case if I have 20 columns to be displayed as a result in the client sheet with the amendment of the recent code it reflects only the 20th column in the Client sheet in the column A.

Regards,
Jagdev
 
Hi,

Pls share your code after amending the changes suggested by me and then with incorporating changes suggested by Luke.

Regards,
Prasad DN
 
Hi Prasad and Luke

Please find the code below:

Code: 
Sub CopyColumnByTitle()
Application.ScreenUpdating = False
 
Dim SearchCols(20) As String
SearchCols(0) = "Legal Entity"
SearchCols(1) = "Business Unit"
SearchCols(2) = "Department"
 
 
'continue with all the column names
Dim i As Integer
'Find "Entity" in Row 1
With Sheets("RAW_Client").Rows(1)
  For i = LBound(SearchCols) To UBound(SearchCols)
  Set t = .Find(SearchCols(i), LookAt:=xlPart)
  'If found, copy the column to Sheet 2, Column A
'If not found, present a message
Dim pasteCol As Long
If Not t Is Nothing Then
    pasteCol = Sheets("Client").Cells(1, .Columns.Count).End(xlToLeft).Column
    If pasteCol <> 1 Then pasteCol = pasteCol + 1
    Columns(t.Column).EntireColumn.Copy _
    Destination:=Sheets("Client").Cells(1, pasteCol)
Else
    MsgBox "Name Not Found"
End If
  Next
End With
 
    Application.ScreenUpdating = True
End Sub
 
:( Bah, the fault is mine. Corrected code:
Code: 
Sub CopyColumnByTitle()
Dim pasteCol As Long
Dim t As Range
Dim i As Integer
Dim SearchCols(20) As String
SearchCols(0) = "Legal Entity"
SearchCols(1) = "Business Unit"
SearchCols(2) = "Department"
'continue with all the column names


Application.ScreenUpdating = False


With Sheets("RAW_Client").Rows(1)
    For i = LBound(SearchCols) To UBound(SearchCols)
        Set t = .Find(SearchCols(i), LookAt:=xlPart)
        'If found, copy the column to Sheet 2, Column A
        'If not found, present a message
       
        If Not t Is Nothing Then
            If Sheets("Client").Range("A1").Value = "" Then
                pasteCol = 1
            Else
                pasteCol = Sheets("Client").Cells(1, .Columns.Count).End(xlToLeft).Offset(0, 1).Column
            End If
           
            .Columns(t.Column).EntireColumn.Copy _
            Destination:=Sheets("Client").Cells(1, pasteCol)
        Else
            MsgBox SearchCols(i) & " Not Found"
        End If
    Next
End With

Application.ScreenUpdating = True
End Sub
 
You must log in or register to reply here.
Back
Top