首页 > 解决方案 > 根据单元格值将数据复制到新制作的工作表中

问题描述

我有一个操作日志,用户可以通过带有组合框的用户表单选择会议名称、用户名等。我还创建了一个按钮,用户可以在其中将新会议添加到组合框列表中。

目前我有一个 vba 代码,它将检查 sheet173 上的单元格的值(从用户窗体输入的数据),创建一个以单元格值命名的新工作表,并将 sheet173 中的数据复制到新工作表中。我遇到的问题是,如果添加了一个动作并且已经为此创建了一个工作表,我需要将数据添加到该工作表的下一行。

我已经让代码工作到已经创建工作表但需要添加其他行的位置。我知道exit sub需要出来,但我不知道用什么来代替它。

Sub copy_newsheet()

Dim pname
Dim ws As Worksheet

pname = Sheets("Sheet173").Range("A1").Value

For Each ws In ActiveWorkbook.Sheets

    If ws.Name = pname Then
        Exit Sub
    End If

Next ws

Sheets("Sheet173").Range("A1:E1").Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
ActiveSheet.Name = pname

End Sub

标签: excelvba

解决方案


这应该这样做:

Option Explicit
Sub Test()

    Dim pname As String
    'full quallify your ranges, include the workbook
    pname = ThisWorkbook.Sheets("Sheet173").Range("A1").Value 'thisworkbook means the workbook which contains the code

    'with this variable we can know if the worksheet exists or not
    Dim SheetExists As Boolean
    SheetExists = False

    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = pname Then SheetExists = True
    Next ws

    'check if it doesn't exist
    If Not SheetExists Then
        'if it doesn't exist, then create the worksheet and give it the name from pname
        With ThisWorkbook
            .Sheets.Add After:=.Sheets(.Sheets.Count)
            .Sheets(.Sheets.Count).Name = pname
        End With
    End If

    'with this variable we can find the last row
    Dim LastRow As Long
    With ThisWorkbook.Sheets(pname)
        'calculate the last row on the pname sheet
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        'equal the value from the pname sheet Range A:E to the sheet173 range A1:E1
        .Range(.Cells(LastRow, "A"), .Cells(LastRow, "E")).Value = ThisWorkbook.Sheets("Sheet173").Range("A1:E1").Value
    End With

End Sub

推荐阅读