使用 MS Access VBA 打开 Excel 文件并将数据从一张表移动到另一张表

Question

我是 VBA Excel Access 的新手。我在 Access data-based 中创建了一个宏命令按钮，它应该打开一个 excel 文件并将数据从 sheet1 移动到 sheet2。现在，当数据移动到 sheet2 时，它应该在 c 列中添加一个更新的注释。但是，在 sheet2 中已经存在数据，因此它应该将数据粘贴到 sheet2 中现有数据的下方。 Excel工作表1

在这张表 2 中已经存在数据。现在我的宏应该将数据粘贴到 sheet2 中现有数据的下方

我收到多个错误 我在 Access VBA 中创建了这个宏，因为我已经有一个宏可以将数据从 access 导出到 excel 文件。 在下面，我希望我的宏将数据从工作表 1 移动到工作表 2，并且在工作表 2 中，它应该将退出数据下方的数据粘贴到状态为已更新的状态。

请帮忙。

我的代码：-

Option Compare Database
Option Explicit

Private Sub UpdateXL()

Dim xl As Excel.Application
Dim wb As Excel.Workbook
Dim wr As Excel.Worksheet
Dim ws As Excel.Worksheet
Dim LastRow As Long
Dim i As Long
Dim lr As Long

Set xl = CreateObject("Excel.Application")

Set wb = xl.Workbooks.Open("C:Destination.xlsm")

Set wr = wb.Worksheets("Sheet1")

Set ws = wb.Worksheets("Sheet2")

 

    'Copies then cuts the data from Sheet1" and paste the same in sheet2
   
    With wr
        'LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        lr = wr.Cells(Rows.Count, 1).End(xlUp).Row + 1
        
        Range("A2:B" & LastRow).Cut ws.Range("A2") 'Cut
        
    End With
    
    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

    With ws
    
        LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
        For i = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
         .Cells(i, "B") = Trim(.Cells(i, "B"))
            Select Case .Range("B" & i)
                Case "FXV", "FST", "FLB", "FFH", "FFJ"
                    .Range("C" & i) = "Updated"
            End Select
        Next i
    End With
    
    
End Sub

Answer 1

试试这个 -->

Option Compare Database
Option Explicit

Private Sub UpdateXL()

Dim xl As New Excel.Application
Dim wb As Excel.Workbook
Dim wr As Excel.Worksheet
Dim ws As Excel.Worksheet
Dim LastRow As Long
Dim i As Long
Dim lr As Long

Set xl = CreateObject("Excel.Application")
xl.Visible = True

Set wb = xl.Workbooks.Open("C:DestinationPath.xlsm")

Set wr = Worksheets("Sheet1")

Set ws = Worksheets("Sheet2")

 LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    'Copies then cuts the data from "SampleFile" Sheet1" and paste the same in sheet2
   
    With wr
        'LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row  ' 
        
        lr = wr.Cells(.Rows.Count, 1).End(xlUp).Row
        
        If Not lr = 1 Then .Range("A2:B" & lr).Cut ws.Range("A" & LastRow + 1 & ":" & "B" & LastRow + lr - 1) 'Cut
                
    End With
    

    With ws
        For i = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
         .Cells(i, "B") = Trim(.Cells(i, "B"))
            Select Case .Range("B" & i)
                Case "FXV", "FST", "FLB", "FFH", "FFJ"
                    .Range("C" & i) = "Updated"
            End Select
        Next i
    End With
End Sub

Sample Screenshot