< návrat zpět

MS Excel


Téma: vložit kopírovanou buňku do následně volné buňky rss

Zaslal/a 26.1.2012 23:04

Dobrý den, zdravím všechny šikovné. Potřebuji pomoci s makříčkem. Spuštění makra vždy při změně hodnoty v jedné buňce (do buňky bude načten skenerem kód). Poté kopírovat vypočítanou hodnotu z jiné buňky na jiný list do stejného sloupce, ale vždy pod sebe do následné volné buňky. Už s tím bojuji dlouho a nejsem schopen to dát dohromady, Děkuji za jakoukoliv pomoc. Jen upřesním, že jde o Excel 2003. Děkuji předem

Zaslat odpověď >

#007080
avatar
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
#007087
avatar
Dobrý den, děkuji, tohle spustí makro při změně buňky, ale neřeší to následné kopírování na jiný list do následujícího volného řádku. Jde mi o to kopírovat buňku, např A1 na listu 2 na jiný list, třeba 3, ale stále pod sebe na následující volnou buňku ve sloupci B. Díky za odpověď.citovat
#007090
avatar
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
#007098
avatar
Dobrý den, moc děkuji za pomoc, ale nedokážu aby mi to fungovalo. Myslím, že bude nejlepší, když uvedeme na konkrétním příkladu. V příloze soubor, kde je konkrétně popsáno jak by to mělo fungovat. Díky za pomoc.
Příloha: rar7098_abcd.rar (35kB, staženo 29x)
citovat
#007110
avatar
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. 7citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

odpocet a storno tl.

PavDD • 28.3. 8:53

odpocet a storno tl.

Začátečník • 26.3. 14:39

odpocet a storno tl.

PavDD • 26.3. 10:22

odpocet a storno tl.

elninoslov • 26.3. 7:50

odpocet a storno tl.

PavDD • 26.3. 7:26

odpocet a storno tl.

elninoslov • 25.3. 22:34

odpocet a storno tl.

Začátečník • 25.3. 15:09