copying from one to another in two different folders

[Suryaprakash]

I have 2 folders with names "Folder One" and "Folder Two" having 250 files each with almost similar names with a slight difference. Files in Folder Two have a suffix 1 attached to file names. For example Vishal.xls in Folder One and Vishal1.xls in Folder Two.

I wish to copy range A1:H50 from each file of Folder Two and paste the same in similar file in Folder Two, for example, from Ashok1.xls to Ashok.xls.

Could any one help me out with a code for this. Also I am new to such forums and does not understand the aspect of adding tags. Could somebody explain this to me, so that I do not break any guideline through ignorance.

 

[Jon von der Heyden]

Welcome to the board!

This assumes:
Your files are in 97-2003 workbook format (.xls)
That there is a corresponding file in folder1 for each file in folder2 (no typo's!)

Make sure you update the string variable folder paths...

Public Sub CopyStuff()
    Dim strFileName As String
    Dim wkb1 As Workbook, wkb2 As Workbook

    Const strFolder1 As String = "C:\folder1\"
    Const strFolder2 As String = "C:\folder2\"
    
    strFileName = Dir$(strFolder2 & "*.xls")
    
    Do While Len(strFileName) > 0
        Set wkb1 = Workbooks.Open(strFolder2 & strFileName)
        Set wkb2 = Workbooks.Open(strFolder1 & Replace$(strFileName, "1.xls", ".xls"))
        wkb1.Sheets(1).Range("A1:H50").Copy wkb2.Sheets(1).Range("A1")
        Application.CutCopyMode = False
        wkb1.Close False
        wkb2.Close True
        strFileName = Dir$
    Loop
End Sub

 

[Suryaprakash]

Hi Jon

Thanks for the code. It is working exceedingly well. Unfortunately, I forgot to mention that the data should be pasted at the end of existing data in the respective files, not at A1 position. Can you make this small change in the code?

Thanks once again for your quick and prompt action.

 

[Jon von der Heyden]

No problem,

Public Sub CopyStuff()
    Dim strFileName As String
    Dim wkb1 As Workbook, wkb2 As Workbook

    Const strFolder1 As String = "C:\folder1\"
    Const strFolder2 As String = "C:\folder2\"
    
    strFileName = Dir$(strFolder2 & "*.xls")
    
    Do While Len(strFileName) > 0
        Set wkb1 = Workbooks.Open(strFolder2 & strFileName)
        Set wkb2 = Workbooks.Open(strFolder1 & Replace$(strFileName, "1.xls", ".xls"))
        wkb1.Sheets(1).Range("A1:H50").Copy
        With wkb2.Sheets(1)
            .Range("A" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial
        End With
        Application.CutCopyMode = False
        wkb1.Close False
        wkb2.Close True
        strFileName = Dir$
    Loop
End Sub