仅将新数据从一个工作簿复制到单独的主数据库中。复制

时间:2017-12-05 13:45:53

标签: excel vba excel-vba

我有一张工作表,我需要为每次评估添加周转时间。我可能会在一天内进行20多次评估,每次评估都会有一个新的评估。 在每一天结束时,我需要点击一个命令按钮,它将更新主副本,如果我忘记,我的老板将只有当天或前一天输入的新数据...

Sub CompareArrays()

Dim arr1() As Variant, arr2() As Variant, arr3() As Variant
Dim i As Long, j As Long, k As Long, nextRow As Long
Dim wb1 As Workbook, wb2 As Workbook
Dim x As Boolean

Set wb1 = Workbooks("Workbook1.xlsm") 'Name of first workbook
Set wb2 = Workbooks("Workbook2.xlsx") 'Name of second workbook
arr1 = wb1.Sheets(1).Range("A2:O" & wb1.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row).Value
arr2 = wb2.Sheets(1).Range("A2:O" & wb2.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row).Value
k = 1
For i = LBound(arr1) To UBound(arr1)
    x = True
    For j = LBound(arr2) To UBound(arr2)
        If arr1(i, 1) = arr2(j, 1) Then
            x = False
            Exit For
        End If
    Next j
    If x = True Then
        k = k + 1
        pos = Application.Match(arr1(i, 1), arr1, False) + 1 
        nextRow = wb2.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
        wb2.Sheets(1).Rows(nextRow).EntireRow.Value = wb1.Sheets(1).Rows(pos).EntireRow.Value
    End If
Next i

End Sub

上面的代码根本不起作用,但它是我能想到的最好的...我只需要上次将命令按钮从A:O复制到主工作簿中的所有新数据。

无论我尝试哪种代码(而且我已经尝试过好几个!),我现在所有人都会得到这一切!)不断回击脚本9错误!

请帮助!

谢谢!!!!

1 个答案:

答案 0 :(得分:0)

如果您只是添加到wb1的P列,则单词"已发送"或"未发送"然后使用以下代码:

Sub CompareArrays()
Dim i As Long
Dim wb1 As Workbook, wb2 As Workbook
Set wb1 = Workbooks("Workbook1.xlsm") 'Name of first workbook
Set wb2 = Workbooks("Workbook2.xlsx") 'Name of second workbook
LastRow = wb1.Cells(wb1.Rows.Count, "A").End(xlUp).Row 'check last row of wb1

For i = 2 To LastRow ' loop through wb1 to check if sent or not
    If wb1.Cells(i, 16).Value = "Not Sent" Then 'if not sent then copy the range from A to O, not including the helper column P
        NextfreeRow = wb2.Cells(wb2.Rows.Count, "A").End(xlUp).Row + 1
        wb2.Sheets(1).Range("A" & NextfreeRow & ":O" & NextfreeRow) = wb1.Sheets(1).Range("A" & i & ":O" & i).Value
        wb1.Cells(i, 16).Value = "Sent"
    End If
Next i
End Sub
相关问题