VBA将多个工作簿中的粘贴复制到同一文件夹中的1个中

Question

I have multiple Excel files in a same folder which contains data in worksheet "Case Tracker". I wanted to copy and paste data to all Excel files from one 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 is overlapping. 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("Case Tracker").Select

' copy the source range
Sheets("Case Tracker").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("Case Tracker").Select

' copy the source range
Sheets("Case Tracker").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

EndSub

Answer 1

Replace

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

With

Dim oCell As Range 'Only insert this line once!

With Sheets("Case Tracker")
    Set oCell = .Cells(.Rows.Count, 1).End(xlUp)
End With

If oCell.Row > 1 Then
    Set oCell = oCell.Offset(1, 0)
End If

oCell.Select

You should only declare oCell once, so only put this line once at the top:

Dim oCell As Range

Complete:

Sub OpenCopyPaste()
Dim oCell As Range
Dim rowCount As Integer
' open the source workbook and select the source sheet

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

Sheets("Case Tracker").Select

' copy the source range

With Sheets("Case Tracker")
rowCount = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.Cells(1, 1), .Cells(rowCount, 7)).Select
End With

Selection.Copy

' select current workbook and paste the values starting at A1

Windows("Macro.xlsx").Activate

Sheets("Sheet1").Select

'------------------------------------------------
With Sheets("Sheet1")
    Set oCell = .Cells(.Rows.Count, 1).End(xlUp)
End With

oCell.Select
'------------------------------------------------

ActiveSheet.Paste

Application.CutCopyMode = False

ActiveWorkbook.Save

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

Sheets("Case Tracker").Select

' copy the source range

With Sheets("Case Tracker")
rowCount = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.Cells(1, 1), .Cells(rowCount, 7)).Select
End With

Selection.Copy

' select current workbook and paste the values starting at A1

Windows("Macro.xlsx").Activate

Sheets("Sheet1").Select

'------------------------------------------------
With Sheets("Sheet1")
Set oCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With

oCell.Select
'------------------------------------------------

ActiveSheet.Paste

Application.CutCopyMode = False

ActiveWorkbook.Save
End Sub