Question

我有用户表单，其中有命令按钮和输入文本框。

我想从一个工作表复制指定的范围，然后在另一个工作表中命名并粘贴。我的代码看起来像这样，但它不起作用。

Private Sub CommandButton1_Click()
Dim i, LastRow
Dim ws As Worksheet
Dim k As Integer
Set ws = Worksheets("Vali")
LastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
For i = 4 To LastRow 'find fulfiled rows
If Sheets("Sheet1").Cells(i, "D").Value = 1 Then
Sheets("Sheet1").Range(Cells(i, "B"), Cells(i, "D")).Copy Destination:=Sheets("Vali").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
Dim i As Integer
'Next we use a looping process 'We start the loop from row 2 because our worksheet has headers in row 1
For k = 2 To 100
'Now we define a condition that only if there is data under the headers ItemID, Description,
If Cells(k, "A").Value <> "" And Cells(k, "B").Value <> "" And Cells(k, "C").Value <> "" And Cells(k, "D").Value <> "" And Cells(k, "E").Value = "" Then
Cells(k, "D").Value = Me.txtname.Value
End If
Next
Range("E:E").EntireColumn.AutoFit
Range("B4:D21").ClearContents 'clear content on previos sheet, from where we made copy
ActiveWorkbook.Save
ValiFinish.Hide
End Sub

Answer 1

不确定你在第二个循环上尝试做什么测试，因为没有工作表参考，所以我选择，让我知道它是不是那个

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim LastRow As Double
    Dim ws As Worksheet
    Dim Wv As Worksheet
    Dim k As Integer
    Dim i As Integer
    Dim Ti()
    ReDim Ti(0)
    Dim StartPaste As Double
    Dim EndPaste As Double
    Dim PastedRange As String

    Set ws = Worksheets("Sheet1")
    Set Wv = Worksheets("Vali")

LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
StartPaste = Wv.Range("A" & Rows.Count).End(xlUp).Offset(1).Row

For i = 2 To LastRow
    If ws.Cells(i, "D").Value = 1 Then

        ws.Range(ws.Cells(i, "A"), ws.Cells(i, "D")).Copy _
             Destination:=Wv.Range("A" & Rows.Count).End(xlUp).Offset(1)
        Ti(UBound(Ti)) = i
        ReDim Preserve Ti(UBound(Ti) + i)
        EndPaste = Wv.Range("A" & Rows.Count).End(xlUp).Offset(1).Row - 1

        '2 options because i'm not sur where you want to add the text :
        'First one (write on Vali, I think that's what you are looking to do) :
        If Wv.Cells(EndPaste, "A").Value <> "" And Wv.Cells(EndPaste, "B").Value <> "" And Wv.Cells(EndPaste, "C").Value <> "" _
           And Wv.Cells(EndPaste, "D").Value <> "" And Wv.Cells(EndPaste, "E").Value = "" Then
               Wv.Cells(Wv.Range("A" & Rows.Count).End(xlUp).Row, "E").Value = ValiFinish.TxTNaMe.Value
        End If
        'Second one (write on Sheet1) :
        If ws.Cells(i, "A").Value <> "" And ws.Cells(i, "B").Value <> "" And ws.Cells(i, "C").Value <> "" _
           And ws.Cells(i, "D").Value <> "" And ws.Cells(i, "E").Value = "" Then
               ws.Cells(ws.Range("A" & Rows.Count).End(xlUp).Row, "E").Value = ValiFinish.TxTNaMe.Value
        End If
        'end of options
    End If
Next i

PastedRange = "" & Wv.Name & "!R" & StartPaste & "C1:R" & EndPaste & "C3"
ActiveWorkbook.Names.Add Name:=ValiFinish.TxTNaMe.Value, RefersToR1C1:=PastedRange




'clear content on previous sheet, from where we made copy
For i = LBound(Ti) To UBound(Ti) - 1
   ws.Range("$B$" & Ti(i) & ":$D$" & Ti(i)).ClearContents
Next i


    Wv.Range("E:E").EntireColumn.AutoFit
    Set ws = Nothing
    Set Wv = Nothing

    ActiveWorkbook.Save
    ValiFinish.Hide
    Application.ScreenUpdating = True

End Sub

将范围复制到另一个工作表，并使用此副本从输入框插入名称

1 个答案: