VBA Macro for copy columns by name and paste another sheet

[sinoyon780]

I'm a beginner in VBA, so please assist me.

I have a workbook, and there is one sheet with many columns with different names name line Quality, RFPC, Hi-Temp, Quality, and Hi-Team (it's a mix column name), so I want to copy the columns by a single name, like all Quality columns, to another sheet. It can be all of the quality, RFPC, etc. columns in a new sheet with a category or each column name in a new sheet.

And the workbook is live every time will add some new column it's can be quality , RFPC....etc

I appreciate your help

 

[swapnilk]

Try this code:

Sub CopyColumnsByName()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim sourceRange As Range
    Dim targetRange As Range
    Dim columnName As String
    Dim uniqueNames As Collection
    
    ' Set the source worksheet
    Set sourceSheet = ThisWorkbook.Sheets("Sheet1")
    
    ' Set the range to search in the source sheet
    Set sourceRange = sourceSheet.Range("A1:Z1")
    
    ' Create a collection to store the unique column names
    Set uniqueNames = New Collection
    
    ' Loop through the columns in the source range
    For Each c In sourceRange.Columns
        columnName = c.Value
        
        If Not IsEmpty(columnName) Then
            ' If the column name is not empty, check if it is unique
            On Error Resume Next
            uniqueNames.Add columnName, CStr(columnName)
            On Error GoTo 0
        End If
    Next c
    
    ' Loop through the unique column names
    For Each n In uniqueNames
        columnName = n
        
        ' Create a new sheet with the same name as the column
        Set targetSheet = ThisWorkbook.Sheets.Add
        targetSheet.Name = columnName
        On Error Resume Next
        ' Loop through the columns in the source range
        For Each c In sourceRange.Columns
            If c.Value = columnName Then
                ' If the column name matches the current unique name, copy the column to the new sheet
                c.EntireColumn.Copy Destination:=targetSheet.Cells(1, targetSheet.Columns.Count).End(xlToLeft).Offset(0, 1)
            End If
        Next c
    Next n
    
    ' Clean up
    Set sourceSheet = Nothing
    Set targetSheet = Nothing
    Set sourceRange = Nothing
    Set targetRange = Nothing
    Set uniqueNames = Nothing
End Sub

 

[sinoyon780]

Try this code:

Sub CopyColumnsByName()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim sourceRange As Range
    Dim targetRange As Range
    Dim columnName As String
    Dim uniqueNames As Collection
   
    ' Set the source worksheet
    Set sourceSheet = ThisWorkbook.Sheets("Sheet1")
   
    ' Set the range to search in the source sheet
    Set sourceRange = sourceSheet.Range("A1:Z1")
   
    ' Create a collection to store the unique column names
    Set uniqueNames = New Collection
   
    ' Loop through the columns in the source range
    For Each c In sourceRange.Columns
        columnName = c.Value
       
        If Not IsEmpty(columnName) Then
            ' If the column name is not empty, check if it is unique
            On Error Resume Next
            uniqueNames.Add columnName, CStr(columnName)
            On Error GoTo 0
        End If
    Next c
   
    ' Loop through the unique column names
    For Each n In uniqueNames
        columnName = n
       
        ' Create a new sheet with the same name as the column
        Set targetSheet = ThisWorkbook.Sheets.Add
        targetSheet.Name = columnName
        On Error Resume Next
        ' Loop through the columns in the source range
        For Each c In sourceRange.Columns
            If c.Value = columnName Then
                ' If the column name matches the current unique name, copy the column to the new sheet
                c.EntireColumn.Copy Destination:=targetSheet.Cells(1, targetSheet.Columns.Count).End(xlToLeft).Offset(0, 1)
            End If
        Next c
    Next n
   
    ' Clean up
    Set sourceSheet = Nothing
    Set targetSheet = Nothing
    Set sourceRange = Nothing
    Set targetRange = Nothing
    Set uniqueNames = Nothing
End Sub

Thank you for your support, which I really appreciate. The codes are working fine, with one exception: if I add a new column to the current worksheet, I run the code, and it returns an error, but it should be run, and the new column should be moved to another sheet based on the column name. For example, there were previously 5 columns named "Quality." after run all 5 gose to 1 workshhet with name quality but when i added one new column with name quality then it's not going but it's shoud go and added with previous 5 column.
or can i fix the sheet name with column name and every time run and get all column from main sheet to Named shhet. because data in the main sheet is updated with column entries every time.
Thank you