Možná, že ne úplně rozumím, ale v tomto případě je příkaz Copy - Paste Special - Skip blanks. Pokud to není to, co potřebujete, pak ukážte konkrétní příklad.citovat
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Něco pro fajnšmekry
MS Excel
Téma: Něco pro fajnšmekry 
Zaslal/a eliasex 5.8.2011 10:42
potřebuju odeslat z jednoho sešitu "A" do druhého "B" řádky.Ale jen ty na kterých je text( ty jsou zezhora dolu na x-tý řádek).Ale aby to nebylo tak jednoduché nejřív se vždy musí v sešitě "B" vymazat staré a pak teprve nakopírovat nové...
no konkretní přiklad jeste nemam protože to teprve vytvářím.jak píšete od copy-paste to bych vedel ale jak omezit výber jen na neprázdné..tzn. nedelat natvrdo kopíru prvních 20 řádků když zaplněných je jen 18...citovat
(5.8.2011 16:24)#005712
Toto makro ti to spraví:
Sub Makro1()
Range("A1").Select
Selection.SpecialCells(xlCellTypeLastCell).Select
Rad = Selection.Row
Sl = Selection.Column
i = 0
Set obl = Nothing
Do
If Not Application.WorksheetFunction.CountA(Range("A1").Offset(i, 0).Resize(1, Sl)) = 0 Then
Set obl = Range("A1").Offset(i, 0).Resize(1, Sl)
Exit Do
End If
i = i + 1
Loop Until i > Rad
If obl Is Nothing Then Exit Sub
Do
If Not Application.WorksheetFunction.CountA(Range("A1").Offset(i, 0).Resize(1, Sl)) = 0 Then
Set obl = Union(obl, Range("A1").Offset(i, 0).Resize(1, Sl))
End If
i = i + 1
Loop Until i > Rad
Sheets("Hárok2").Select
Cells.ClearContents
obl.Copy Range("A1")
End Sub
citovat
Sub Makro1()
Range("A1").Select
Selection.SpecialCells(xlCellTypeLastCell).Select
Rad = Selection.Row
Sl = Selection.Column
i = 0
Set obl = Nothing
Do
If Not Application.WorksheetFunction.CountA(Range("A1").Offset(i, 0).Resize(1, Sl)) = 0 Then
Set obl = Range("A1").Offset(i, 0).Resize(1, Sl)
Exit Do
End If
i = i + 1
Loop Until i > Rad
If obl Is Nothing Then Exit Sub
Do
If Not Application.WorksheetFunction.CountA(Range("A1").Offset(i, 0).Resize(1, Sl)) = 0 Then
Set obl = Union(obl, Range("A1").Offset(i, 0).Resize(1, Sl))
End If
i = i + 1
Loop Until i > Rad
Sheets("Hárok2").Select
Cells.ClearContents
obl.Copy Range("A1")
End Sub
citovat
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články