添加"范本"自动产生新工作簿,执行后,,变成范本隐藏工作表代码有问题

cmo9020

请教导师帮看一下代码范本内有隐藏其它工作表代码存在下面代码,,需要多添加"范本"自动产生新工作簿在目录储存不需要连宏都复制

但是执行后,都卡住,变成范本隐藏工作表代码有问题
请导师们帮忙修改一下,看怎样储存新工作簿时,不会产生问题,谢谢


Sub XXX()
    Dim arr, i&, j&, strFind$, Rng As Range, rngFind As Range
    Dim iRow&, wkb1 As Workbook, wkb2 As Workbook, shp As Shape

    Set wkb1 = ActiveWorkbook

    Set wkb2 = Workbooks.Open(ThisWorkbook.Path & "\A\数据.xlsx")
    With wkb2.Sheets("数据表")
        arr = Range(.[B3], .[B3].End(xlToRight))
        iRow = .Cells(Rows.Count, "B").End(xlUp).Row + 1
        For i = 1 To UBound(arr, 2)
         Set rngFind = wkb1.Sheets(1).Cells.Find(arr(1, i), , , xlWhole)
            If Not rngFind Is Nothing Then
               arr(1, i) = rngFind.Offset(, 1).Value
               Else
               arr(1, i) = ""
            End If
        Next i
        .Cells(iRow, "B").Resize(, UBound(arr, 2)) = arr
        With .[B3].CurrentRegion
            .Columns(1).NumberFormatLocal = "m月d日"
            .HorizontalAlignment = xlCenter
            .Borders.LineStyle = xlContinuous

        End With
    End With

    wkb2.Save
    wkb2.Close
End Sub

3190496160

文字表述语言不通顺，难以理解你的意思

tanglf188

问的人明明白白，听的人一头雾水

cmo9020

3190496160 发表于 2023-1-3 13:22
文字表述语言不通顺，难以理解你的意思

唉...导师您好,苦了好几天,没头绪,代码自己拆出一些,现在弄原本的给您看看
就是不管代码怎样修改
要把"范本"导出成新工作簿,这里都会出错(如图)


Sub xxx()
    Dim arr, i&, j&, strFind$, Rng As Range, rngFind As Range
    Dim iRow&, wkb1 As Workbook, wkb2 As Workbook, shp As Shape

    DoApp False
    strFind = [B4]
    If isWksExists1(CStr(strFind)) Then
       With Sheets(CStr(strFind))
          iRow = .Cells(Rows.Count, "A").End(xlUp).Row
          Set Rng = Range(.[A15], .Cells(iRow, "H"))
       End With
    End If
    ActiveSheet.Copy
    Set wkb1 = ActiveWorkbook
    With wkb1.Sheets(1)
        If Not Rng Is Nothing Then
           Rng.Copy .[A15]
        End If
        For Each shp In .Shapes
            shp.Delete
        Next
    End With

    Set wkb2 = Workbooks.Open(ThisWorkbook.Path & "\A\数据.xlsx")
    With wkb2.Sheets("数据表")
        arr = Range(.[B3], .[B3].End(xlToRight))
        iRow = .Cells(Rows.Count, "B").End(xlUp).Row + 1
        For i = 1 To UBound(arr, 2)
         Set rngFind = wkb1.Sheets(1).Cells.Find(arr(1, i), , , xlWhole)
            If Not rngFind Is Nothing Then
               arr(1, i) = rngFind.Offset(, 1).Value
               Else
               arr(1, i) = ""
            End If
        Next i
        .Cells(iRow, "B").Resize(, UBound(arr, 2)) = arr
        With .[B3].CurrentRegion
            .Columns(1).NumberFormatLocal = "m月d日"
            .HorizontalAlignment = xlCenter
            .Borders.LineStyle = xlContinuous
            .EntireColumn.AutoFit
            .EntireRow.AutoFit
        End With
    End With

    wkb2.Close True
    wkb1.SaveAs ThisWorkbook.Path & "\" & strFind
    wkb1.Close
    DoApp
    Beep
End Sub

cmo9020

3190496160 发表于 2023-1-3 13:22
文字表述语言不通顺，难以理解你的意思

己弄好,知道问题点了,谢谢导师们