用原始文件中的数据更新主工作簿的VBA代码

Question

我正在尝试处理一个代码，该代码可以使我从原始文件中复制数据并更新主工作簿中原始列A中每个值的单个工作表文件。

背景：在原始文件的A列中提到了许多唯一ID，其他列包含与每个唯一ID相对应的数据。每个唯一ID在主工作簿中都有一个单独的工作表。

要求：

1. 删除在原始文件
2. 复制从原始文件中的整行的被删除表中提及的不希望的唯一的ID，定位相关的唯一ID片在主工作簿和粘贴最后一行的数据。
3. 如果主工作簿中没有唯一的ID表，则创建它并粘贴数据。

问题：

1. ，我有卡在主定位正确的表的代码，它是无法找到表，当它来创建一个名为新的一页它给出表格名称已经存在的错误。
2. 如果需要为唯一ID创建新工作表，它应该继续循环并粘贴其他ID的数据。
3. 它应该在最后给出一个消息框，提供所有新建工作表的详细信息。

请帮我解决......我一直在试图解决这个问题。

RAW文件（Excel）中：

主文件（Excel）中：在主文件

工作表名称：

代码：

Sub unique_ids() 
    Dim NewFN As String, MasterFN As String 
    Dim lrow As Long, i As Long, drow As Long, j as Long 
    Dim rngf As Range, rngv As Range 
    Dim SName As Variant 
    Dim FoundDup As Range 

    'Open the Master file 
    proceed: 
    MasterFN = Application.GetOpenFilename(FileFilter:="All files (*.*), *.*",  Title:="Please open the Master File") 
    If MasterFN = "" Then 
    MsgBox "You have not selected a file." 
    GoTo proceed 
    Else 
    Workbooks.Open Filename:=MasterFN 
    End If 
    MasterFN = ActiveWorkbook.Name 

    'Open the raw file 
    proceed1: 
    NewFN = Application.GetOpenFilename(FileFilter:="All files (*.*), *.*", Title:="Please open the raw File") 
    If NewFN = "" Then 
    MsgBox "You have not selected a file." 
    GoTo proceed1 
    Else 
    Workbooks.Open Filename:=NewFN 
    End If 

    'Save backup file 
    ActiveWorkbook.SaveAs Filename:="D:\Counts-" & Format(Date, "dd-mmm-yy") & ".xlsx", FileFormat:= _ 
    xlOpenXMLWorkbook, CreateBackup:=False 
    Workbooks("Counts-" & Format(Date, "dd-mmm-yy") & ".xlsx").Close 
    Workbooks.Open Filename:=NewFN 
    NewFN = ActiveWorkbook.Name 

    'Delete the "to be removed" IDs 
    Sheets("counts").Select 
    For Row = Range("A65536").End(xlUp).Row To 2 Step -1 

    Set FoundDup = Sheets("To be deleted").Range("A:A").Find(Cells(Row, 1), LookIn:=xlValues, lookat:=xlWhole) 

    If Not FoundDup Is Nothing Then 
     Cells(Row, 1).EntireRow.Delete 
    End If 

    Next Row 

    ‘Update Data 

    For j = 2 To lrow 
    SName = Workbooks(NewFN).Worksheets("counts").Range("K" & j).Value 
    On Error GoTo new_tab 
    Workbooks(NewFN).Worksheets("Counts").Range("A" & j & ":I" & j).Copy  Workbooks(MasterFN).Worksheets(SName).Range("B" & Rows.Count).End(xlUp).Offset(1, 0) 
    Workbooks(MasterFN).Worksheets(SName).Range("A" & Rows.Count).End(xlUp).Value = Format(Date, "dd-mmm-yy") 
    drow = Workbooks(MasterFN).Worksheets(SName).Range("K" & Rows.Count).End(xlUp).Offset(-1, 0).Row 
    Workbooks(MasterFN).Worksheets(SName).Range("K" & drow - 1 & ":S" & drow - 1).Copy Workbooks(MasterFN).Worksheets(SName).Range("K" & drow & ":S" & drow) 
    Next j 

    new_tab: 
    MsgBox "New ID encountered", vbCritical 
    Workbooks(MasterFN).Sheets.Add(after:=Workbooks(MasterFN).Sheets(Worksheets.Count)).Name = SName 
    Workbooks(NewFN).Worksheets("counts").Range("A" & j & ":I" & j).Copy  Workbooks(MasterFN).Worksheets(SName).Range("B" & Rows.Count).End(xlUp) 
    Workbooks(MasterFN).Worksheets(SName).Range("A" & Rows.Count).End(xlUp).Value = Format(Date, "dd-mmm-yy") 
    drow = Workbooks(MasterFN).Worksheets(SName).Range("K" & Rows.Count).End(xlUp) 
    Workbooks(MasterFN).Worksheets(SName).Range("K" & drow - 1 & ":S" & drow - 1).Copy Workbooks(MasterFN).Worksheets(SName).Range("K" & drow & ":S" & drow) 

    MsgBox "This work is now complete, new sheet added - " & SName 

    End Sub   

Answer 1

的我在这里可以看到的第一个潜在问题是在For j = 2 To lrow循环你继续参考变量i而不是我认为应该是j。我看不到i变量已经在任何地方初始化了？