MS Excel

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range: Set rng = [A1:F10] - stanovit rozsah měnících se buněk
If Not Intersect(rng, Target) Is Nothing Then MyMacro - tady je jmeno vašého makra
End Sub

Chcete-li najít poslední neprazdný řádek v listu, například, ve sloupci A -

Function xlLastRow(Optional WorksheetName As String) As Long

If WorksheetName = vbNullString Then
WorksheetName = ActiveSheet.Name
End If
With Worksheets(WorksheetName)
xlLastRow = .Cells.Find("*", .Cells(1), xlFormulas, _
xlWhole, xlByRows, xlPrevious).Row
End With

End Functioncitovat

Můžete změnit a používat následující dva kody:

Sub copytonextsheet()
With Sheets("Sheet2")
n = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Cells(n, "A").Resize(, 4).Value = _
Cells(1, "A").Resize(, 4).Value
End With
End Sub

Sub CopyRowsWithNumbersInG()
Dim X As Long
Dim LastRow As Long
Dim Source As Worksheet
Dim Destination As Worksheet
Dim RowsWithNumbers As Range
Set Source = Worksheets("name")
Set Destination = Worksheets("name")
With Source
LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
For X = 2 To LastRow
If IsNumeric(.Cells(X, "E").Value) And .Cells(X, "E").Value <> "" Then
If RowsWithNumbers Is Nothing Then
Set RowsWithNumbers = .Cells(X, "E")
Else
Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(X, "E"))
End If
End If
Next
If Not RowsWithNumbers Is Nothing Then
RowsWithNumbers.EntireRow.Copy Destination.Range("A4")
End If
End With
MsgBox "Data has been updated !!", vbExclamation + vbInformation, "Company Name"
End Sub

V kombinaci s následující funkce
Function xlLastRow(Optional WorksheetName As String) As Long

If WorksheetName = vbNullString Then
WorksheetName = ActiveSheet.Name
End If
With Worksheets(WorksheetName)
xlLastRow = .Cells.Find("*", .Cells(1), xlFormulas, _
xlWhole, xlByRows, xlPrevious).Row
End With

End Functioncitovat

Dobrý den, dokáže mi s tím někdo pomoci? Moc děkuji za jakoukoliv pomoc, nedokážu to dát sám dohromady. citovat