Question

我正在尝试将数据从一个工作簿复制到另一个工作簿。

我的源工作簿，包含722行的数据。但代码只复制了72行。

当我在调试时，在siiurcewkbk中，我可以看到722行被选中但是在destwkb中它只被粘贴了72行。

另外，我的sourcewb中的列在AK中，我希望它们粘贴在destwb的A列中。

有谁可以帮我纠正这个问题。

Sub Extract()
Dim x As Workbook
Dim y As Workbook
Dim Val As Variant
Dim filename As String
Dim LastCell As Range
Dim LastRow As Long

CopyCol = Split("AK", ",")
LR = Cells(Rows.Count, 1).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column
LCell = Activewindow.RangeSelection.SpecialCells(xlCellTypeLastCell).Address
LCC = Activewindow.RangeSelection.SpecialCells(xlCellTypeLastCell).Column
lcr = Activewindow.RangeSelection.SpecialCells(xlCellTypeLastCell).Row

Set y = ThisWorkbook
    Dim path1, Path2
path1 = ThisWorkbook.Path
Path2 = path1 & "\Downloads"
Set x = Workbooks.Open(filename:=Path2 & "\Red.xlsx")

For Count = 0 To UBound(CopyCol)
  Set temp = Range(CopyCol(Count) & "1:" & CopyCol(Count) & lcr)
  If Count = 0 Then
    Set CopyRange = temp
  Else
    Set CopyRange = Union(CopyRange, temp)
  End If
Next

CopyRange.Copy
y.Sheets("All").Paste y.Sheets("All").Range("A4")
Application.CutCopyMode = False
x.Close
End Sub

anylead会有所帮助。

Answer 1

如果您只是将一列数据从一个工作表复制到另一个工作表中的另一列，则可以采用更简单的方法。以下代码有帮助吗？对不起，如果我误解了你的要求......

Sub Extract()
    Dim Path2 As String  '** path to the workbook you want to copy to ***
    Dim X As Workbook '*** WorkBook to copy from ****
    Dim Y As Workbook '** WorkBook to copy to

    Set X = ActiveWorkbook '** This workbook ****
    Path2 = "C:\test" '** path of book to copy to
    Set Y = Workbooks.Open(filename:=Path2 & "\Red.xlsx")
    X.Sheets("From").Range("A:A").Copy Destination:=Y.Sheets("ALL").Range("A1")
    Application.CutCopyMode = False
    Y.Save
    Y.Close
End Sub

Answer 2

尝试这个，我注释掉了一些我无能为力的行，因为我对代码很严格。我还添加了一些Dim语句，因为我总是在模块顶部用Option Explicit编写代码，这可以帮助程序员捕获隐藏的编译错误。

问题的解决方案在

行中

    Dim rngLastCell As Excel.Range
    Set rngLastCell = Range(CopyCol(Count) & "65535").End(xlUp)

所以我们在这里做的是去第65535行的工作表的最后一行（我知道以后的版本有更多的行，但是这个数字很好）然后我们说End（xlUp）在逻辑上意味着这个列，直到找到一些文本作为数据块的底行。

就在下面我改变了Range语句的语法，它非常灵活，因此一个名为Range的字符串调用Range（“A1：B3”）或者一个可以调用Range，每个单元格都有两个参数，所以Range（Range）（ “A1”），范围（ “B3”））。

Option Explicit

Sub Extract()
    Dim x As Workbook
    Dim y As Workbook
    Dim Val As Variant
    Dim filename As String
    Dim LastCell As Range
    Dim LastRow As Long

    Dim CopyCol
    CopyCol = Split("AK", ",")

    '* LR is never used
    'LR = Cells(Rows.Count, 1).End(xlUp).Row

    '* lc is never used
    'lc = Cells(1, Columns.Count).End(xlToLeft).Column

    '* LCell is never used
    'LCell = ActiveWindow.RangeSelection.SpecialCells(xlCellTypeLastCell).Address

    '* LCC is never used
    'LCC = ActiveWindow.RangeSelection.SpecialCells(xlCellTypeLastCell).Column

    Dim lcr
    lcr = ActiveWindow.RangeSelection.SpecialCells(xlCellTypeLastCell).Row

    Set y = ThisWorkbook
    Dim path1, Path2
    path1 = ThisWorkbook.Path
    Path2 = path1 & "\Downloads"
    Set x = Workbooks.Open(filename:=Path2 & "\Red.xlsx")

    Dim Count As Long
    For Count = 0 To UBound(CopyCol)

        Dim rngLastCell As Excel.Range
        Set rngLastCell = Range(CopyCol(Count) & "65535").End(xlUp)

        Dim temp As Excel.Range
        'Set temp = Range(CopyCol(Count) & "1:" & CopyCol(Count) & lcr)
        Set temp = Range(CopyCol(Count) & "1", rngLastCell)
        If Count = 0 Then
            Dim CopyRange As Excel.Range
            Set CopyRange = temp
        Else
            Set CopyRange = Union(CopyRange, temp)
        End If
    Next

    CopyRange.Copy
    y.Sheets("All").Paste y.Sheets("All").Range("A4")
    Application.CutCopyMode = False
    x.Close
End Sub

Answer 3

CopyCol = Split("AK", ",")是Array("AK") ...为什么？ For Count = 0 To UBound(CopyCol) ... Next从0到0（一个周期）运行。

把它放在一个较短的子目录中，我推荐这样的东西：

Sub Extract()

  Dim path1 As String
  path1 = ThisWorkbook.Path & "\Downloads"

  Dim CopyCol As String
  CopyCol = "AK"

  With Workbooks.Open(filename:=path1 & "\Red.xlsx")

    With .ActiveSheet
      .Range(.Cells(1, CopyCol), .Cells(.Rows.Count, CopyCol).End(xlUp)).Copy ThisWorkbook.Sheets("All").Range("A4")
    End With

  .Close
  End With

End Sub

将数据从一个工作簿复制到另一个工作簿时出错

3 个答案: