将工作表数据复制到另一个工作表的末尾

时间:2015-07-31 14:11:16

标签: vba excel-vba copy copy-paste excel

我能够复制一个工作簿的最后一行并将其粘贴到另一个工作簿的最后一行之后。我想复制第一个工作簿中第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

3 个答案:

答案 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)

设置s1Sheets2Sheet后,我认为您应该可以使用这两行复制&立即粘贴整个范围:

    '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