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?
 
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
 
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
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
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
 
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
 
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.