从顶部开始将动态单元格从一张纸复制到另一张纸

时间:2017-06-21 15:20:51

标签: excel vba copy

我正在创建一个输入框来搜索A列中的数据。

例如,如果在第A行第243行中找到数据,我想将该单元格(在我的情况下是一个范围)复制到另一个电子表格中,从第A行第2行开始。

有人可以帮我解决这个问题吗?非常感谢。

谢谢

Sub Sales_Rep()


Dim r As Integer
Dim c As Integer

Dim X As String
Dim i As Integer
Dim j As Range


' Deteling the extra sheets of previous Sales representatives

If Worksheets.Count > 4 Then

Worksheets("Sales Rep").Delete

End If

X = Application.InputBox("Please insert the Sales Rep Code")


' Calculating the number of rows and Columns

Worksheets("Data Set Macro").Activate

r = ActiveSheet.UsedRange.Rows.Count
c = ActiveSheet.UsedRange.Columns.Count

Debug.Print r
Debug.Print c

' Add another tab where we can see all the details of the selected sales representative

Worksheets.Add.Name = "Sales Rep"

' Copy of the header from the original tab to the new tab

Worksheets("Data Set Macro").Range("A1:D1").Copy _
    Worksheets("Sales Rep").Range("A1:D1")


'Worksheets("Data Set Macro").Activate


 For i = 2 To r
 'For j = 2 To 5


   Worksheets("Data Set Macro").Activate

    If Cells(i, 1) = X Then

            Worksheets("Data Set Macro").Range(Cells(i, 1), Cells(i, c)).Select
                 Selection.Copy

        Worksheets("Sales Rep").Activate
            Worksheets("Sales Rep").Range(Cells(i, 1), Cells(i, c)).Select
                ActiveSheet.Paste


    End If

'Next j
Next i




End Sub

1 个答案:

答案 0 :(得分:0)

Dim ol, nw As Worksheet

Set ol = ThisWorkbook.Worksheets("Old")
Set nw = ThisWorkbook.Worksheets("New")


    ncell = ol.Range("A65536").End(xlUp).Row

With ol.Range(Cells(1, 1), Cells(ncell, 1))
 Set dist = .Find(X, LookIn:=xlValues)
    If Not dist Is Nothing Then
        firstAddress = dist.Address
        Do
            ncellnw = nw.Range("A65536").End(xlUp).Row
            nw.Cells(ncellnw,1).Value = firstAddress
            Set dist = .FindNext(dist)
        Loop While Not dist Is Nothing And dist.Address <> firstAddress
    End If
End With

它应该工作,你声明工作表,然后搜索X中的值(输入框上的字符串)。

其中ncell和ncellnw给最后一行写了一些写在A列上的东西