在工作簿之间复制单元格

tru*_*nks 7 excel vba excel-vba

有人可以帮我一些VBA代码.

我试图在工作簿之间复制2个单元格范围(两个工作簿都应该事先创建,因为我不希望代码在运行中创建新的工作簿).

首先,我需要复制这些范围 - 从booka.xls的"Sheet 3",Range:Cell H5到H列的最后一行,将数据复制到bookb.xls的"Sheet 1",从Cell B2开始细胞向下进入B柱

其次,我需要复制这些范围 - 从booka.xls的"Sheet 3",Range:Cell K5到K列的最后一行,将数据复制到bookb.xls的"Sheet 1",从Cell D2开始D列中的细胞

这是我到目前为止:

 Sub CopyDataBetweenBooks()

Dim iRow        As Long
    Dim wksFr       As Worksheet
    Dim wksTo       As Worksheet

    wksFr = "C:\booka.xls"
    wksTo = "C:\bookb.xls"

    Set wksFrom = Workbooks(wksFr).Worksheets("Sheet 3")
    Set wksTo = Workbooks(wksTo).Worksheets("Sheet 1")

    With wksFrom
        For iRow = 1 To 100
            .Range(.Cells(iRow, 8), .Cells(iRow, 9)).Copy wksTo.Cells(iRow, 8)
        Next iRow
    End With

End Sub
Run Code Online (Sandbox Code Playgroud)

jon*_*sca 1

以下是如何执行其中一列的示例:

Option Explicit
Sub CopyCells()
    Dim wkbkorigin As Workbook
    Dim wkbkdestination As Workbook
    Dim originsheet As Worksheet
    Dim destsheet As Worksheet
    Dim lastrow As Integer
    Set wkbkorigin = Workbooks.Open("booka.xlsm")
    Set wkbkdestination = Workbooks.Open("bookb.xlsm")
    Set originsheet = wkbkorigin.Worksheets("Sheet3")
    Set destsheet = wkbkdestination.Worksheets("Sheet1")
    lastrow = originsheet.Range("H5").End(xlDown).Row
    originsheet.Range("H5:H" & lastrow).Copy  'I corrected the ranges, as I had the src
    destsheet.Range("B2:B" & (2 + lastrow)).PasteSpecial 'and destination ranges reversed
End Sub
Run Code Online (Sandbox Code Playgroud)

正如您在评论中所述,上面的代码不适用于带空格的范围,因此请用下面的代码替换该行lastrow

lastrow = originsheet.range("H65536").End(xlUp).Row
Run Code Online (Sandbox Code Playgroud)

现在理想情况下,您可以将其制作成一个子例程,该子例程接受原始工作簿名称、工作表名称/编号和范围,以及目标工作簿名称、工作表名称/编号和范围。那么您就不必重复某些代码。