尝试根据条件将数据行从一个工作簿移动到另一个工作簿- Excel VBA

ih99xse1 于 2023-03-13 发布在其他

关注(0)|答案(1)|浏览(149)

非常感谢k1dr0ck帮助我完成下面的代码。
有人知道如何修改此代码，使其在运行IF语句之前自动打开目标工作簿吗？我尝试了一些方法，但宏在使用.Open命令后停止运行。
以下是我目前拥有的：
子按钮3_单击（）

Dim sourceWB As Workbook
Dim sourceWS As Worksheet
Dim destWB As Workbook
Dim destWS As Worksheet
Dim sourceRange As Range
Dim destRange As Range
Dim lastRow As Long
Dim i As Long

Set sourceWB = Workbooks("Copy of Copy of Copy of Pace Duplicate Check 2023 (002).xlsm")
Set sourceWS = sourceWB.Worksheets("PAID")
Set destWB = Workbooks("MacroTestWorkbook.xlsm")
Set destWS = destWB.Worksheets("Sheet1")
lastRow = sourceWS.Cells(Rows.Count, "J").End(xlUp).Row ' Determine the last row in column J

For i = lastRow To 1 Step -1 ' Loop through the range backwards to avoid skipping rows after deletion
    If sourceWS.Cells(i, "J").Value = "REMOVE" Then
        Set sourceRange = sourceWS.Rows(i)
        Set destRange = destWS.Cells(destWS.Rows.Count, "A").End(xlUp).Offset(1, 0) ' Determine the first empty row in destination sheet
        sourceRange.Copy destRange ' Copy the row to destination sheet
        sourceRange.Delete ' Delete the row from source sheet
    End If

Next i

destWB.Save
destWB.Close

末端子组件

excel

来源：https://stackoverflow.com/questions/75691831/trying-to-move-rows-of-data-from-one-workbook-to-another-based-on-condition-ex

1条答案

按热度按时间

sgtfey8w1#

相应修改：

Sub CopyRowsToDestination()
    Dim sourceWB As Workbook
    Dim sourceWS As Worksheet
    Dim destWB As Workbook
    Dim destWS As Worksheet
    Dim sourceRange As Range
    Dim destRange As Range
    Dim lastRow As Long
    Dim i As Long
    
    Set sourceWB = ThisWorkbook ' Replace with the name of the source workbook
    Set sourceWS = sourceWB.Worksheets("Sheet1") ' Replace with the name of the source worksheet
    Set destWB = Workbooks("destination.xlsx") ' Replace with the name of the destination workbook
    Set destWS = destWB.Worksheets("Sheet1") ' Replace with the name of the destination worksheet
    lastRow = sourceWS.Cells(Rows.Count, "J").End(xlUp).Row ' Determine the last row in column J
    
    For i = lastRow To 1 Step -1 ' Loop through the range backwards to avoid skipping rows after deletion
        If sourceWS.Cells(i, "J").Value = "remove" Then
            Set sourceRange = sourceWS.Rows(i)
            Set destRange = destWS.Cells(destWS.Rows.Count, "A").End(xlUp).Offset(1, 0) ' Determine the first empty row in destination sheet
            sourceRange.Copy destRange ' Copy the row to destination sheet
            sourceRange.Delete ' Delete the row from source sheet
        End If
    Next i
End Sub

赞(0）回复(0）举报 2023-03-13

我来回答

尝试根据条件将数据行从一个工作簿移动到另一个工作簿- Excel VBA

1条答案

相关问题

热门标签

最新问答