VBA copy Paste from multiple workbooks into 1 on same folder

[rohan2906]

I have multiple excel files in a same folder which contains data in sheet1. I wanted to copy paste data all the excel files into 1 excel file "Macro.xlsx". The code is like it copies data from Rahul.xlsx to Macro.xlsx and then from Rohit.xlsx to Macro.xlsx and so on. The problem is that while pasting data from Rohit.xlsx it ios overlaping. The code is not finding the next available blank row to paste data and this is due to code [Sheets("Sheet1").Range("A1").Select]. Can someone help me edit the code.

Sub OpenCopyPaste()

' open the source workbook and select the source sheet

Workbooks.Open Filename:="C:\Users\Rahul\Desktop\Test\Rahul.xlsx"

Sheets("Sheet1").Select

' copy the source range

Sheets("Sheet1").Range("A:G").Select

Selection.Copy

' select current workbook and paste the values starting at A1

Windows("Macro.xlsx").Activate

Sheets("Sheet1").Select

Sheets("Sheet1").Range("A1").Select

ActiveSheet.Paste

Application.CutCopyMode =False

ActiveWorkbook.Save

Workbooks.Open Filename:="C:\Users\Rahul\Desktop\Test\Rohit.xlsx"

Sheets("Sheet1").Select

' copy the source range

Sheets("Sheet1").Range("A:G").Select

Selection.Copy

' select current workbook and paste the values starting at A1

Windows("Macro.xls").Activate

Sheets("Sheet1").Select

Sheets("Sheet1").Range("A1").Select

ActiveSheet.Paste

Application.CutCopyMode =False

ActiveWorkbook.Save

EndSub

 

[Luke M]

The trick would be do use the End method to find the last used cell.

You code had a lot of unnecessary Select's and repeated code, so I simplified it.

Sub RunThisMacro()
'We're doing the same thing, just to 2 different workbooks
Call OpenCopyPaste(Workbooks.Open("C:\Users\Rahul\Desktop\Test\Rahul.xlsx"))
Call OpenCopyPaste(Workbooks.Open("C:\Users\Rahul\Desktop\Test\Rohit.xlsx"))
End Sub

Sub OpenCopyPaste(sourceWB As Workbook)
Dim destWB As Workbook
Dim destWS As Worksheet

'Define where our objects are, just to avoid confusion
Set destWB = Workbooks("Macro.xlsx")
Set destWS = destWB.Worksheets("Sheet1")

' copy the source range to first blank line
With destWS
    sourceWB.Sheets("Sheet1").Range("A:G").Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
End With

'Close files
Application.CutCopyMode = False
sourceWB.Close False
destWB.Save
End Sub

 

[rohan2906]

Hi Luke.... Thanks for the reply... Can you please recheck as I am getting Runtime 1004 error "Copy area and paste area are not of same size.

 

[Luke M]

Ah, forgot, you're trying to copy an entire column...let's try this:

Sub RunThisMacro()
'We're doing the same thing, just to 2 different workbooks
Call OpenCopyPaste(Workbooks.Open("C:\Users\Rahul\Desktop\Test\Rahul.xlsx"))
Call OpenCopyPaste(Workbooks.Open("C:\Users\Rahul\Desktop\Test\Rohit.xlsx"))
End Sub

Sub OpenCopyPaste(sourceWB As Workbook)
Dim destWB As Workbook
Dim destWS As Worksheet
Dim copyRange As Range

'Define where our objects are, just to avoid confusion
Set destWB = Workbooks("Macro.xlsx")
Set destWS = destWB.Worksheets("Sheet1")

'Only copy the used section, not entire columns
With sourceWB.Worksheets("Sheet1")
    Set copyRange = Intersect(.Range("A:G"), .UsedRange)
End With

' copy the source range to first blank line
With destWS
    copyRange.Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
End With

'Close files
Application.CutCopyMode = False
sourceWB.Close False
destWB.Save
End Sub