我能够复制一个工作簿的最后一行并将其粘贴到另一个工作簿的最后一行之后。我想复制第一个工作簿中第2行(第1行是标题)的整个数据,并将其粘贴到另一个工作簿的最后一行之后。请告诉我下面代码中需要进行哪些更改才能复制第2行而不是最后一行的整个数据。
Dim lastS1Row As Long
Dim nextS2Row As Long
Dim lastCol As Long
Dim lCol As Long
Dim lCol1 As Long
Dim s1Sheet As Worksheet, s2Sheet As Worksheet
Dim source As String
Dim target As String
Dim path As String
Dim path1 As String
source = "Students" 'Source Worksheet Name
path1 = "H:\Shaikh_Gaus\scratch\VBA\Book17.xlsx"
path = "H:\Shaikh_Gaus\scratch\VBA\Book16.xlsx"
target = "Students" 'Target Worksheet Name
Application.EnableCancelKey = xlDisabled
Set s1Sheet = Workbooks.Open(path).Sheets(source)
Set s2Sheet = Workbooks.Open(path1).Sheets(target)
lastS1Row = s1Sheet.Range("A" & Rows.Count).End(xlUp).Row
nextS2Row = s2Sheet.Range("A" & Rows.Count).End(xlUp).Row + 1
lastCol = s1Sheet.Cells(1, Columns.Count).End(xlToLeft).Column
For lCol = 1 To lastCol
s2Sheet.Cells(nextS2Row, lCol) = s1Sheet.Cells(lastS1Row, lCol)
Next lCol
Next lCol1
s2Sheet.Activate
ActiveWorkbook.Close SaveChanges:=True
s1Sheet.Activate
ActiveWorkbook.Close
答案 0 :(得分:1)
这个调整后的代码版本可以完成这项工作:
Dim s1Sheet As Worksheet, s2Sheet As Worksheet
Dim source As String
Dim target As String
Dim path As String
Dim path1 As String
Dim rngSource As Range
Dim rngTargetStart As Range
source = "Students" 'Source Worksheet Name
path1 = "H:\Shaikh_Gaus\scratch\VBA\Book17.xlsx"
path = "H:\Shaikh_Gaus\scratch\VBA\Book16.xlsx"
target = "Students" 'Target Worksheet Name
Application.EnableCancelKey = xlDisabled
Set s1Sheet = Workbooks.Open(path).Sheets(source)
Set s2Sheet = Workbooks.Open(path1).Sheets(target)
Set rngSource = Range(s1Sheet.Range("A2"), s1Sheet.Cells.SpecialCells(xlCellTypeLastCell))
Set rngTargetStart = s2Sheet.Range("A" & Rows.Count).End(xlUp).Offset(1)
rngTargetStart.Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value
s2Sheet.Parent.Close SaveChanges:=True
s1Sheet.Parent.Close
我删除了一些似乎没必要的东西。主要的是现在你不循环遍历列和行。现在你可以通过一次操作来完成它。
尽量避免.Select
,.Activate
之类的事情。如果您只需要粘贴值,请.Copy
。你可以像我一样做一些类似的事情:
Target.Value = Source.Value
答案 1 :(得分:0)
设置s1Sheet
和s2Sheet
后,我认为您应该可以使用这两行复制&立即粘贴整个范围:
'copy Cells A2 through last row and last column used
s1Sheet.Range(s1Sheet.Cells(2, 1), s1Sheet.Cells(s1Sheet.Cells(s1Sheet.Rows.Count, 1).End(xlUp).Row, _
s1Sheet.Cells(1, s1Sheet.Columns.Count).End(xlToLeft).Column)).Copy
'paste those cells in next blank row of second sheet
s2Sheet.Cells(s2Sheet.Cells(s2Sheet.Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial Paste:=xlPasteAll
答案 2 :(得分:-1)
'Here you go:
Range("A2").End(xlDown).select
selection.End(xlRight).select
selection.copy
'then active the next sheet for e.g Sheet2.Active
last_row = range("A1048576").end(xlup).row
range("A" & last_row).paste
' Done