Скопируйте текущую активную строку из одного листа на другой

StackOverflow https://stackoverflow.com//questions/22081260

Вопрос

У меня есть вопрос для копирования текущей активной строки с одного листа на другой.Скажем, у меня есть следующие столбцы имя, адрес, город, тел, почтовый индекс в листе1, и у меня есть похожие столбцы в листе 2. Скажем, я в настоящее время говорю на ряд 100 или 500 или 1000 из имени столбца листа 1. Я хочу только скопировать эту строку для листа 2 и заполнить столбцы в листе 2. До сих пор у меня есть этот код.Пожалуйста, дайте мне знать, как продолжить.

Private Sub CommandButton1_Click()
Dim CustomerName As String, Customeraddress As String, Customercity As String, Custtel As String, Custzip As String
Worksheets("sheet1").Select
CustomerName = Range("A2")
Customeraddress = Range("B2")
Customercity = Range("C2")
Custtel = Range("D2")
Custzip = Range("E2")
Worksheets("sheet2").Select
Worksheets("Sheet2").Range("B4").Select
If Worksheets("Sheet2").Range("B4").Offset(1, 0) <> "" Then
Worksheets("Sheet2").Range("B4").End(xlDown).Select
End If
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = CustomerName
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Customeraddress
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Customercity
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Custtel
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Custzip
Worksheets("Sheet1").Select
Worksheets("Sheet1").Range("C4").Select
End Sub
.

Это было полезно?

Решение

команда команд размещена в листе1

попробуйте этот код:

Private Sub CommandButton1_Click()
    Dim lastrow As Long

    With ThisWorkbook.Worksheets("Sheet2")
        lastrow = Application.Max(4, .Cells(.Rows.Count, "B").End(xlUp).Row + 1)
        .Range("B" & lastrow).Resize(, 5).Value = _
            Range("A" & ActiveCell.Row).Resize(, 5).Value
    End With
End Sub
.

Лицензировано под: CC-BY-SA с атрибуция
Не связан с StackOverflow
scroll top