Question

大家欢呼！下面的代码应该将数据从一个工作簿传输到另一个工作簿。我设置了两条路径和一切。该代码完成了一半的工作。但是，它告诉我没有正确选择班级范围，我不明白它是什么错误。

在代码中，我将评论留在了我收到错误的行。此外，我如何确保每次将数据从wb2传输到wb1时，它都不会覆盖已经存储在wb1中的数据？

提前致谢！

注意：

wb1是具有传输数据按钮的工作簿，需要粘贴。

wb2：是需要打开的工作簿，并从中复制数据。

Private Sub Transferdata_Click()


Dim intChoice As Integer
Dim strPath As String
Dim filname As String

   Dim wb1            As Workbook ' the workbook where I paste the data
   Dim wb2              As Workbook 'the workbook I copy the data

     Set wb1 = ActiveWorkbook


    MsgBox ("Please open the workbook you need to transfer the data from")


Call Application.FileDialog(msoFileDialogOpen).Filters.Clear

intChoice = Application.FileDialog(msoFileDialogOpen).Show

If intChoice <> 0 Then

strPath = Application.FileDialog( _
msoFileDialogOpen).SelectedItems(1)


filname = Split(strPath, "\")(UBound(Split(strPath, "\")))

Application.ScreenUpdating = False

Workbooks.Open Filename:=strPath


   Windows(filname).Activate
    Set wb2 = ActiveWorkbook

   wb2.Sheets("File").Range("A3").Select ' I get the error here. don't understand why
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

wb1.Activate

   wb1.Sheets("File2").Select
   Range("A4").Select
       Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False ' how can I make sure here that every time when I copy the data from wb2 to wb1 won't overwrite the data that is already in wb1? to paste the data starting from the row that is empty? 



Application.ScreenUpdating = True

End If
End Sub

Answer 1

我认为这应该有效。已删除所有选择并激活并为两者分配工作簿变量。

Private Sub Transferdata_Click()

Dim intChoice As Long
Dim strPath As String
Dim filname As String
Dim wb1 As Workbook ' the workbook where I paste the data
Dim wb2 As Workbook 'the workbook I copy the data

Set wb1 = ActiveWorkbook
MsgBox ("Please open the workbook you need to transfer the data from")
Call Application.FileDialog(msoFileDialogOpen).Filters.Clear
intChoice = Application.FileDialog(msoFileDialogOpen).Show

If intChoice <> 0 Then
    strPath = Application.FileDialog( _
    msoFileDialogOpen).SelectedItems(1)
    filname = Split(strPath, "\")(UBound(Split(strPath, "\")))
    Application.ScreenUpdating = False
    Set wb2 = Workbooks.Open(Filename:=strPath)
    With wb2.Sheets("File")
        .Range("A3", .Range("A3").End(xlDown)).Copy
    End With
    With wb1.Sheets("File2")
        .Range("A" & .Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
    End With
    Application.ScreenUpdating = True
End If

End Sub

Answer 2

正如Rory在评论中提到的那样，最好避免使用。选择这样的情况。我认为将范围变量变暗并使用它来复制/粘贴会更容易：

    Dim rng As Range
    Set rng = wb2.Sheets("File").Range("A3")
    wb2.Sheets("File").Range(rng, rng.End(xlDown)).Copy

您可以对粘贴操作执行相同操作。为避免覆盖数据，请首先检查A4单元格中是否存在任何数据。如果那里有数据，你可以使用xlDown获取包含数据的最后一行，然后再过去一行。

Dim rng2 As Range
If wb1.Sheets("File2").Range("A4") = "" Then
    Set rng2 = wb1.Sheets("File2").Range("A4")
Else
    Set rng2 = wb1.Sheets("File2").Range("A4").End(xlDown).Offset(1,0)
End If
rng2.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

选择类别范围失败的方法错误1004

2 个答案: