Copy rows to different workbook with different filenames

user_18701422 0
Viewed 32

I want to a workbook "xyz", copy its header row (1st row) rom sheet1 and paste it to a different workbook's (mnp) sheet1 which is already opened.

Next open a workbook "pqr" and open a workbook from different folder path(abc) and paste it to header row (1st row). Each workbook has only one sheet.

I have written below codes,here i have to change the file name everytime and run it. Please assign a easy dynamic code.

 Windows("XYZ.xlsx").Activate
    Rows("1:1").Select
    Selection.Copy
    Application.WindowState = xlNormal
    Windows("mnp.xlsx").Activate
    Rows("1:1").Select
    ActiveSheet.Paste
    Windows("Book1").Activate
vba excel
1 Answers

Copy Headers to Another Workbook

Sub CopyHeadersTEST()
    CopyHeaders "xyz.xlsx", "mnp.xlsx"
    CopyHeaders "C:\Test\pqr.xlsx", "C:\Data\abc.xlsx"
End Sub

Sub CopyHeaders( _
        ByVal SourceNameOrPath As String, _
        ByVal DestinationNameOrPath As String)
    Const ProcName As String = "CopyHeader"
    On Error GoTo ClearError
    
    Dim swb As Workbook
    On Error Resume Next
        Set swb = Workbooks(SourceNameOrPath)
    On Error GoTo ClearError
    If swb Is Nothing Then Set swb = Workbooks.Open(SourceNameOrPath)
    
    Dim dwb As Workbook
    On Error Resume Next
        Set dwb = Workbooks(DestinationNameOrPath)
    On Error GoTo ClearError
    If dwb Is Nothing Then Set dwb = Workbooks.Open(DestinationNameOrPath)
    
    swb.Worksheets(1).Rows(1).Copy dwb.Worksheets(1).Cells(1)

ProcExit:
    Exit Sub
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Sub
user_98140690
Related