将范围复制到另一个工作表，并从此输入框中插入名称 [英] Copy range to another sheet and insert name from Input Box with this copy

问题描述

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

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

  Private Sub CommandButton1_Click（）
 Dim我，LastRow 
 Dim ws As Worksheet 
 Dim k As Integer 
设置ws = Worksheets（Vali）
 LastRow = Sheets（Sheet1）。Range（A & Rows.Count）.End（xlUp）.Row 
对于i = 4 To LastRow找到已满足的行
如果表格（Sheet1）。Cells（i，D）。Value = 1然后
表（Sheet1）。范围（单元格（i，B），单元格（i，D））复制目标：=表格（Vali）。范围（A & Rows.Count）.End（xlUp）.Offset（1）
 End If 
 Next i 
 Dim i As Integer 
'接下来我们使用循环过程'我们开始第2行的循环，因为我们的工作表在第1行中有标题
对于k = 2到100 
'现在我们定义一个条件，只有在标题下有数据ItemID，描述，
如果Cells（k，A）。值<> 和细胞（k，B）。 和细胞（k，C）。值<> 和细胞（k，D）。值< 和细胞（k，E）。值=然后
细胞（k，D）。值= Me.txtname.Value 
结束如果
下一个
 Range（E：E）。EntireColumn.AutoFit 
范围（B4：D21）。ClearContents的清晰内容，从我们制作副本
 ActiveWorkbook.Save 
 ValiFinish.Hide 
 End Sub 
  

解决方案

不确定你试图用你的测试做第二个循环，因为没有表格参考，所以我选择，让我知道如果不是那个

  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 
 
设置ws =工作表（Sheet1）
设置Wv =工作表（Vali）
 
 Las tRow = ws.Range（A& Rows.Count）.End（xlUp）.Row 
 StartPaste = Wv.Range（A& Rows.Count）.End（xlUp）.Offset（1）.Row 
 
对于i = 2 To LastRow 
如果ws.Cells（i，D）。值= 1然后
 
 ws.Range（ws.Cells（i，A），ws .Cells（i，D））复制_ 
目标：= Wv.Range（A& Rows.Count）.End（xlUp）.Offset（1）
 Ti（UBound （Ti））= i 
 ReDim保存Ti（UBound（Ti）+ i）
 EndPaste = Wv.Range（A& Rows.Count）.End（xlUp）.Offset（1） .Row  -  1 
 
'2选项，因为我不是sur你要添加的文本：
'第一个（写在Vali，我认为这是你想要做的）：
如果Wv.Cells（EndPaste，A）。值<> 和Wv.Cells（EndPaste，B）。值<> 和Wv.Cells（EndPaste，C）。值<> _ 
和Wv.Cells（EndPaste，D）。值<> 和Wv.Cells（EndPaste，E）。值=然后
 Wv.Cells（Wv.Range（A& Rows.Count）.End（xlUp）.Row，E ）.Value = ValiFinish.TxTNaMe.Value 
 End If 
'第二个（在Sheet1上写）：
如果ws.Cells（i，A）。值<> 并且ws.Cells（i，B）。值<> 并且ws.Cells（i，C）。值<> _ 
和ws.Cells（i，D）。值<> 和ws.Cells（i，E）。值=然后
 ws.Cells（ws.Range（A& Rows.Count）.End（xlUp）.Row，E ）.Value = ValiFinish.TxTNaMe.Value 
结束如果
'选项结束
结束If 
 Next i 
 
 PastedRange =& Wv.Name& ！R& StartPaste& C1：R& EndPaste& C3
 ActiveWorkbook.Names.Add名称：= ValiFinish.TxTNaMe.Value，RefersToR1C1：= PastedRange 
 
 
 
 
'清除以前的内容表单，从我们制作副本
对于i = LBound（Ti）到UBound（Ti） -  1 
 ws.Range（$ B $& Ti（i）&：$ D $& Ti（i））。ClearContents 
 Next i 
 
 
 Wv.Range（E：E）。EntireColumn.AutoFit 
设置ws =没有
设置Wv =没有
 
 ActiveWorkbook.Save 
 ValiFinish.Hide 
 Application.ScreenUpdating = True 
 
 End Sub 
  

I have User form where I have command button and input text box.

I want to copy specified range from one worksheet, then name and paste in another sheet. My code looks like this, but it is not working.

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

解决方案

Not sure what you were trying to do with your test on you second loop, because there was no sheet reference, so I choose, let me know if it wasn't that

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

这篇关于将范围复制到另一个工作表，并从此输入框中插入名称的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！