Question

我想将数据从第二行复制到最后一行并过去另一个工作簿的最后一行。我使用了bwlo编码，但它显示错误：

方法'object'_Worksheet的单元格失败。

以下是我的代码

Dim myFileNameDir As String
Dim myFileNameDir1 As String
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim iRow1 As Long


myFileNameDir = "H:\Shaikh_Gaus\scratch\VBA\Book16.xlsx"
Workbooks.Open Filename:=myFileNameDir, UpdateLinks:=0
Set ws = Worksheets("Students")


myFileNameDir1 = "H:\Shaikh_Gaus\scratch\VBA\Book17.xlsx"
Workbooks.Open Filename:=myFileNameDir, UpdateLinks:=0
Set ws1 = Worksheets("Students")


Dim LastRow As Long, i As Long, ii As Long
Dim r As Long, rlastrow As Long
rlastrow = ws1.Cells(Rows.Count, "A").End(xlUp).Row 
LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row 
r = rlastrow
Application.ScreenUpdating = False
For i = 2 To LastRow
                r = r + 1
            ws.Range("A" & i).EntireRow.Copy Destination:=ws1.Range("A" & r)'change Sheet Name to suit
Next
MsgBox "Macro is Done", vbInformation, "Created By Lancerj017"
Application.ScreenUpdating = True

Answer 1

Public Function isWorkbookOpen(ByVal strName As String) As Boolean
    Dim wb As Workbook
    For Each wb In Workbooks
        If wb.Name = strName Then
            isWorkbookOpen = True
            Exit Function
        End If
    Next
    isWorkbookOpen = False
End Function

Public Sub test()
    Dim myFileNameDir As String
    Dim myFileNameDir1 As String
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim LastRow As Long
    Dim rlastrow As Long

    If isWorkbookOpen("Book16.xlsx") Then
        Set ws = Workbooks("Book16.xlsx").Worksheets("Students")
    Else
        myFileNameDir = "H:\Shaikh_Gaus\scratch\VBA\Book16.xlsx"
        Workbooks.Open Filename:=myFileNameDir, UpdateLinks:=0
        Set ws = Worksheets("Students")
    End If

    If isWorkbookOpen("Book17.xlsx") Then
        Set ws1 = Workbooks("Book17.xlsx").Worksheets("Students")
    Else
        myFileNameDir1 = "H:\Shaikh_Gaus\scratch\VBA\Book17.xlsx"
        Workbooks.Open Filename:=myFileNameDir, UpdateLinks:=0
        Set ws1 = Worksheets("Students")
    End If

    rlastrow = ws1.UsedRange.Rows.Count
    LastRow = ws.UsedRange.Rows.Count
    ws.Rows("2:" & LastRow).Copy Destination:=ws1.Range("A" & rlastrow + 1)
    MsgBox "Macro is Done", vbInformation, "Created By Lancerj017"
End Sub

复制数据并在另一个工作簿中过去

1 个答案: