使用储值调用或创建调用sheet

Question

我有一个工作簿可以创建其他工作簿并根据第一列中的值将数据转移到它们。后记我需要工作簿将它刚刚复制的数据存储在与存储变量同名的sheet中（在下一个空行中），或者如果它不存在则创建选项卡。

但是我在使用变量名称粘贴到选项卡时遇到问题，并且不知道如何创建新的 sheet 如果变量不存在 sheet .

这是我遇到的问题 With Worksheets(SupID).Range("A" & LastRow(SupID) + 1).Paste。

当前代码如下。谢谢！

Private Sub CopyItOver()

 Dim myVal As String
 Dim SupID As String

    'Store Supplier ID
  SupID = Trim(Sheets("Raw Data").Range("A2").Value)

    'Create workbook
  Set newbook = Workbooks.Add

    'Copy Records
  Set myRng = Workbooks("Book1.xlsm").Worksheets("Raw Data").Range("B2:X7")
  myRng.Copy
  newbook.Worksheets("Sheet1").Range("A2").PasteSpecial (xlPasteValues)

    'Create Header
  newbook.Worksheets("Sheet1").Range("A1").Value = "ZHF"
  newbook.Worksheets("Sheet1").Range("B1").Value = "CTO"
  newbook.Worksheets("Sheet1").Range("C1").Value = "RET"
  newbook.Worksheets("Sheet1").Range("D1").Value = SupID
  newbook.Worksheets("Sheet1").Range("E1").Value = "RET"
  newbook.Worksheets("Sheet1").Range("F1").Value = "RET"
  newbook.Worksheets("Sheet1").Range("G1").Value = "6"
  newbook.Worksheets("Sheet1").Range("H1").Value = "PROD"
    newbook.Worksheets("Sheet1").Range("J1").Value =     newbook.Worksheets("Sheet1").Range("B1").Value _
    & newbook.Worksheets("Sheet1").Range("D1").Value & "TEMPNUMBER"
  newbook.Worksheets("Sheet1").Range("I1").Value =     newbook.Worksheets("Sheet1").Range("J1").Value _
    & newbook.Worksheets("Sheet1").Range("C1").Value & ".CSV"
 newbook.Worksheets("Sheet1").Range("K1") = Format(Date, "ddmmyyyy")
 newbook.Worksheets("Sheet1").Range("L1").Value = "Unknown"
 newbook.Worksheets("Sheet1").Range("M1").Value = "1"

LastRow = newbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row

    'Create Footer
  newbook.Worksheets("Sheet1").Range("A" & LastRow + 1).Value = "ZFV"
  newbook.Worksheets("Sheet1").Range("B" & LastRow + 1).Value = "BATCH" & "TEMPNUMBER"
  newbook.Worksheets("Sheet1").Range("C" & LastRow + 1).Value =     WorksheetFunction.CountIf(Sheets("Sheet1").Range("A1:A1000"), "RET")

    'Name Sheet
  myVal = newbook.Worksheets("Sheet1").Range("J1").Value & "RET"
  newbook.Worksheets("Sheet1").Name = myVal

    'Copy to relevant matching sheet
    With Worksheets(SupID).Range("A" & LastRow(SupID) + 1).Paste
    End With

    'Save Workbook
  NewBook.SaveAs Filename:=NewBook.Worksheets("Sheet1").Range("I1").Value

End Sub
Function DLastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                        After:=sh.Range("A1"), _
                        Lookat:=xlPart, _
                        LookIn:=xlValues, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
    On Error GoTo 0
End Function

Answer 1

一些不太正确的地方：

在模块顶部添加 Option Explicit 并声明您的变量。
LastRow 将是 Long 数据类型，但您正试图将其用作 With Worksheets(SupID).Range("A" & LastRow(SupID) + 1).Paste 中的数组。只需使用 LastRow+1.
With Worksheets(SupID).Range("A" & LastRow(SupID) + 1).Paste End With 可能应该是 Worksheets(SupID).Range("A" & LastRow + 1).Paste，但它会粘贴 myRng - 看不到您复制的任何其他内容。
在您引用的代码开头 Workbooks("Book1.xlsm")。如果这是代码所在的工作簿，我会将其更改为 ThisWorkbook.
SupID 查看当时处于活动状态的工作簿上的原始数据（初始化该变量时不指定工作簿）。

如果命名工作表存在，此函数将 return TRUE/FALSE:

Public Function WorkSheetExists(SheetName As String) As Boolean
    Dim wrkSht As Worksheet
    On Error Resume Next
        Set wrkSht = ThisWorkbook.Worksheets(SheetName)
        WorkSheetExists = (Err.Number = 0)
        Set wrkSht = Nothing
    On Error GoTo 0
End Function

希望能为您指明正确的方向:)

编辑： 刚注意到....

而不是写：

  newbook.Worksheets("Sheet1").Range("A1").Value = "ZHF"
  newbook.Worksheets("Sheet1").Range("B1").Value = "CTO"
  newbook.Worksheets("Sheet1").Range("C1").Value = "RET"
  newbook.Worksheets("Sheet1").Range("D1").Value = SupID
  newbook.Worksheets("Sheet1").Range("E1").Value = "RET"
  newbook.Worksheets("Sheet1").Range("F1").Value = "RET"
  newbook.Worksheets("Sheet1").Range("G1").Value = "6"
  newbook.Worksheets("Sheet1").Range("H1").Value = "PROD"

您可以只使用：

newbook.Worksheets("Sheet1").Range("A1:H1") = Array("ZHF", "CTO", "RET", "SupID", "RET", "RET", "6", "Prod")

Answer 2

发生错误是因为 Worksheets(SupID).Range("A" & LastRow(SupID) + 1).Paste 正在尝试在您的活动图书（即新图书）上查找该工作表。您需要 Activate 原始数据工作簿或将行更改为 ThisWorkbook.Worksheets(SupID).Range("A" & LastRow(SupID) + 1).Paste.

但是，在 VBA 中使用（显式或隐式）Activate、Select 或其他击键样式命令并不是很好。鉴于您只是复制值（而不是工作表格式），那么您最好将数据读入变体数组并对其进行操作。我已经调整了您的代码以证明这一点。

还有一些其他的编码方面可能不像它们应该的那样健壮。我不会一一列举，但将此代码与您的代码进行比较将有助于您了解它们。

Private Sub CopyItOver()
    Dim newBook As Workbook
    Dim supSheet As Worksheet
    Dim v As Variant
    Dim supID As String
    Dim namePrefix As String
    Dim footerCount As Integer
    Dim i As Integer

    'Store Supplier ID
    supID = Trim(ThisWorkbook.Worksheets("Raw Data").Range("A2").value)
    namePrefix = "CTO" & supID & "TEMPNUMBER"

    'Create workbook
    Set newBook = Workbooks.Add

    'Copy Records
    v = rawDataSheet.Range("B2:X7").value
    For i = 1 To UBound(v, 1)
        If v(i, 1) = "RET" Then footerCount = footerCount + 1
    Next

    'Write new sheet
    With newBook.Worksheets(1)
        'Values
        .Range("A2").Resize(UBound(v, 1), UBound(v, 2)).value = v
        'Header
        .Range("A1").Resize(, 13) = Array( _
            "ZHF", "CTO", "RET", supID, "RET", "RET", "6", "PROD", _
            namePrefix & "RET.CSV", namePrefix, _
            Format(Date, "ddmmyyyy"), "Unknown", "1")
        'Footer
        .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 3).value = Array( _
            "ZFV", "BATCH TEMPNUMBER", footerCount)
        'Name
        .Name = namePrefix & "RET"
        'Save
        .SaveAs Filename:=namePrefix & "RET.CSV"
    End With

    'Copy to relevant matching sheet
    On Error Resume Next
    Set supSheet = ThisWorkbook.Worksheets(supID)
    On Error Goto 0
    If newSheet Is Nothing Then
        With ThisWorkbook.Worksheets
            Set supSheet = .Add(After:=.Item(.Count))
        End With
        supSheet.Name = supID
    End If

    With supSheet
        .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(v, 1), UBound(v, 2)).value = v
    End With

End Sub

Answer 3

我设法使用 Here 的帮助解决了我的问题，我在单独的模块中适应了下面的代码和运行，这允许使用以前未指定的 sheet 名称，即稍后从单元格值派生的名称。如果 sheet 不存在，则创建它，将名称与存储的值匹配并将数据粘贴到其中。感谢支持！

Sub TEST()

    Dim i As Integer, blnFound As Boolean
    blnFound = False

    SupID = Trim(Sheets("Raw Data").Range("A2").Value)
    Set myRng = Workbooks("Book1.xlsm").Worksheets("Raw Data").Range("B2:X7")

    myRng.Copy

    With ThisWorkbook
        For i = 1 To .Sheets.Count
            If .Sheets(i).Name = SupID Then
            blnFound = True
            .Sheets(i).Activate
            ActiveSheet.Paste Destination:=Range("A" & LastRow + 1)
            Exit For
            End If
        Next i

        If blnFound = False Then
        .Sheets.Add
        With ActiveSheet
            .Name = SupID

            ActiveSheet.Paste Destination:=Range("A" & LastRow + 1)
        End With
        End If
    End With

End Sub

使用储值调用或创建调用sheet

Use stored value to call or create & call sheet

excel

vba

worksheet