Copy and paste between 2 workbooks located in same folder

I have Two Files
Red
Black
Details- We have to
copy all the data of sheet5 of Red and paste the data to Black sheet4
copy all the data of sheet8 of Red and paste the data to Black sheet2
copy all the data of sheet9 of Red and paste the data to Black sheet6
copy all the data of sheet1 of Red and paste the data to Black sheet7
copy all the data of sheet3 of Red and paste the data to Black sheet10

All this we have to do by vba only
both files are in same folder
My file path-  C:\Users\user\Desktop\New folder
Avinash SinghAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

tuviCommented:
where vba code resides? in Red or Black or a new workbook?
When pasting to the black sheet... is that sheet empty?? or just append the new data to the end?
0
Avinash SinghAuthor Commented:
In red vba code resides
That sheet has data but not in specified sheets so we have to paste the data in all that sheets
0
tuviCommented:
for example,

copy all the data of sheet5 of Red and paste the data to Black sheet4

does the Black has sheet4 already? if yes, does sheet4 in Black already has data?
0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Avinash SinghAuthor Commented:
U r right and yes black has sheet4 already buy its blank no data is there
0
Avinash SinghAuthor Commented:
But its blank no data is there
0
tuviCommented:
Here is the Code:

(Make sure that your worksheets' names are all small letter like sheet1, sheet2,,,, not Sheet1, Sheet2... or else you have to change it in the code to match...)

Const FolderName As String = "C:\Users\user\Desktop\New folder\"

Public Sub RedToBlack()
   Dim Black As Workbook
   
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   
   Set Black = Workbooks.Open(FolderName & "Black.xlsx")
   
   ThisWorkbook.Worksheets("sheet5").Copy , Black.Worksheets("sheet4")
   Black.Worksheets("sheet4").Delete
   Black.ActiveSheet.Name = "sheet4"
   ThisWorkbook.Worksheets("sheet8").Copy , Black.Worksheets("sheet2")
   Black.Worksheets("sheet2").Delete
   Black.ActiveSheet.Name = "sheet2"
   ThisWorkbook.Worksheets("sheet9").Copy , Black.Worksheets("sheet6")
   Black.Worksheets("sheet6").Delete
   Black.ActiveSheet.Name = "sheet6"
   ThisWorkbook.Worksheets("sheet1").Copy , Black.Worksheets("sheet7")
   Black.Worksheets("sheet7").Delete
   Black.ActiveSheet.Name = "sheet7"
   ThisWorkbook.Worksheets("sheet3").Copy , Black.Worksheets("sheet10")
   Black.Worksheets("sheet10").Delete
   Black.ActiveSheet.Name = "sheet10"
   
   Black.Save
   
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True
      
   Set Black = Nothing
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Roy CoxGroup Finance ManagerCommented:
This code assumes the data starts in A1 and has a header row. If not it will need amending.

The code first checks that the source workbook is open, if not it opens it.

Place the code in the Black workbook.

Option Explicit

Sub CombineData()
    Dim oWb As Workbook
    Dim oWs As Worksheet
    Dim rToCopy As Range, rNextCl As Range
    Dim wbIsOpen As Boolean

    ''/// Check if workbook is open
    On Error Resume Next
    Set oWb = Workbooks("Red.xlsx")
    On Error GoTo 0
    If oWb Is Nothing Then
        ''/// If workbook was NOT open, we'll open it
        Set oWb = Workbooks.Open(ThisWorkbook.Path & Application.PathSeparator & "Red.xlsx", ReadOnly:=True)
        ''/// remember workbook was closed
        wbIsOpen = False
    End If

    ''///copy all the data of sheet5 of Red and paste the data to Black sheet4
    Set oWs = oWb.Sheets("Sheet5")
    ''/// assumes data starts in A1 and there is a header row
    Set rToCopy = oWs.Cells(.CurrentRegion)
    With ThisWorkbook.Sheets("Sheet4")
        Set rNextCl = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
        rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
                                    rToCopy.Columns.Count).Copy rNextCl
    End With
    'copy all the data of sheet8 of Red and paste the data to Black sheet2
    Set oWs = oWb.Sheets("Sheet8")
    ''/// assumes data starts in A1 and there is a header row
    Set rToCopy = oWs.Cells(.CurrentRegion)
    With ThisWorkbook.Sheets("Sheet2")
        Set rNextCl = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
        rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
                                    rToCopy.Columns.Count).Copy rNextCl
    End With
    ''///copy all the data of sheet9 of Red and paste the data to Black sheet6
    Set oWs = oWb.Sheets("Sheet9")
    ''/// assumes data starts in A1 and there is a header row
    Set rToCopy = oWs.Cells(.CurrentRegion)
    With ThisWorkbook.Sheets("Sheet6")
        Set rNextCl = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
        rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
                                    rToCopy.Columns.Count).Copy rNextCl
    End With
    ''///copy all the data of sheet1 of Red and paste the data to Black sheet7
    Set oWs = oWb.Sheets("Sheet1")
    ''/// assumes data starts in A1 and there is a header row
    Set rToCopy = oWs.Cells(.CurrentRegion)
    With ThisWorkbook.Sheets("Sheet7")
        Set rNextCl = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
        rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
                                    rToCopy.Columns.Count).Copy rNextCl
    End With
    'copy all the data of sheet3 of Red and paste the data to Black sheet10
    Set oWs = oWb.Sheets("Sheet3")
    ''/// assumes data starts in A1 and there is a header row
    Set rToCopy = oWs.Cells(.CurrentRegion)
    With ThisWorkbook.Sheets("Sheet10")
        Set rNextCl = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
        rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
                                    rToCopy.Columns.Count).Copy rNextCl
    End With
''/// if workbook as closed, then close it now
    If Not wbIsOpen Then oWb.Close   

End Sub

Open in new window

0
Avinash SinghAuthor Commented:
Thnx Tuvi for giving ur precious time and support to this post & Thnx Roy Cox sir  for giving ur precious time and support to this post
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.