VB Script for copy -paste column values of excel

Help Something Else
1

VB-SCRIPT
Need to copy column values in bulk from from excel1 to excel2.
I need to use Colum names.

EXCEL1
COLUMN : Site code (H3)
Sheet: ABC

EXCEL 2
COLUMN: Master
Sheet: XYZ

2

@Nidhi_Kowalli

I believe you dont need vba

  1. Search for required column names using find/replace…extact the column name only using regex
  2. Can get row count using Excel.Sheet("SheetName").RowCount
  3. Use values from step 1 and 2 to copy paste range usign copy/paste range activity

cheers

3

I need VB Script itself

4

@Nidhi_Kowalli

Awesome

' Define the source and destination Excel files
Dim sourceFile, destinationFile, columnName
sourceFile = "C:\path\to\source.xlsx"
destinationFile = "C:\path\to\destination.xlsx"
columnName = "ColumnHeaderName"  ' Change this to your column header name

' Create Excel application object
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
objExcel.DisplayAlerts = False

' Open the source workbook
Set sourceWorkbook = objExcel.Workbooks.Open(sourceFile)
Set sourceSheet = sourceWorkbook.Sheets(1)  ' Change sheet index if needed

' Find the column index with the specified header name
Dim columnIndex
columnIndex = -1
For Each cell In sourceSheet.Rows(1).Cells
    If cell.Value = columnName Then
        columnIndex = cell.Column
        Exit For
    End If
Next

' Check if the column was found
If columnIndex = -1 Then
    MsgBox "Column with the header name '" & columnName & "' not found."
    sourceWorkbook.Close False
    objExcel.Quit
    WScript.Quit
End If

' Select the entire column
Set sourceRange = sourceSheet.Columns(columnIndex)

' Open the destination workbook
Set destinationWorkbook = objExcel.Workbooks.Open(destinationFile)
Set destinationSheet = destinationWorkbook.Sheets(1)  ' Change sheet index if needed

' Find the last column in the destination sheet
lastColumn = destinationSheet.Cells(1, destinationSheet.Columns.Count).End(-4159).Column ' -4159 is xlToLeft

' Paste the copied column to the next available column in the destination sheet
destinationSheet.Cells(1, lastColumn + 1).Resize(sourceRange.Rows.Count, 1).Value = sourceRange.Value

' Save and close the workbooks
destinationWorkbook.Save
sourceWorkbook.Close False
destinationWorkbook.Close False

' Clean up
objExcel.Quit
Set objExcel = Nothing
Set sourceWorkbook = Nothing
Set destinationWorkbook = Nothing
Set sourceSheet = Nothing
Set destinationSheet = Nothing

MsgBox "Column copied successfully."

Note: generated via chatgpt

cheers

5

@Nidhi_Kowalli,

It’s not tried and tested but you would be able to get it worked with minimal efforts.

Function CopyCol(strSourceFile As String, strDestFile As String, srcColName As String, destColName As String) As Boolean

Dim HeaderRange As Range
Dim srcWbk As Workbook
Dim destWbk As Workbook

Set srcWbk = Workbooks.Open(strSourceFile)
Set destWbk = Workbooks.Open(strDestFile)

Set HeaderRange = srcWbk.Worksheets("ABC").Range("A1:ZZ1")

For Each hcell In HeaderRange ' Loop through each header cell
    If hcell.Value = srcColName Then ' If it matches your query then copy entire column
        Set HeaderRange = destWbk.Worksheets("XYZ").Range("A1:ZZ1")
        For Each icell In HeaderRange
            If icell.Value = destColName Then
                Range(hcell.Address).EntireColumn.Copy _
                Destination:=destWbk.Sheets("XYZ").Range(icell.Address)
                GoTo FinishExecution
            End If
        Next icell
    End If
Next hcell

FinishExecution:
CopyCol = True

End Function

Thanks,
Ashok :slight_smile:

6

This not working as Column Header consists of braces.
Column name: Site code (H3)

7

@Nidhi_Kowalli

Can you tell what error are you getting?

it will work with special characters also

cheers