Question

我在同一文件夹中有多个Excel文件，其中包含工作表“案例跟踪器”中的数据。我想将数据从一个Excel文件“Macro.xlsx”复制并粘贴到所有Excel文件。代码就像是将数据从Rahul.xlsx复制到Macro.xlsx，然后从Rohit.xlsx复制到Macro.xlsx，依此类推。问题是，从Rohit.xlsx粘贴数据时，它是重叠的。代码未找到下一个可用空白行来粘贴数据，这是由代码Sheets("Sheet1").Range("A1").Select引起的。有人可以帮我编辑代码

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

替换

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

使用

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

你应该只声明一次oCell，所以只把这一行放在顶部一次：

Dim oCell As Range

达成：

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

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

1 个答案: