< návrat zpět

MS Excel


Téma: přenos dat mezi listy v sešitu rss

Zaslal/a 25.11.2018 15:22

fudyAhoj lidi, potřebuju poradit jak dostat nová data z tabulky na jednom listu do druhého listu v jednom sešitu ještě než dám uložit a zavřít. Do tabulky zapisuji denně jiná data, některá tam nechám jiná smažu a dodám jiná data(pokaždé jsou jiná, protože se liší obsahem některé z buněk)
příklad 1: do tabulky A napíšu nová data k těm stávajícím - výsledek do listu2 se mi nakopírují nová data k již vytvořenému seznamu
příklad 2: v tabulce A smažu data z některých prostřední řádků, spodní řádky posunu výše - výsledek do listu2 se nic nenakopíruje(nejsou zapsána nová data
příklad 3: v tabulce A smažu data z některých prostřední řádků, spodní řádky posunu výše a zadám nová data - výsledek do listu2 se mi nakopírují nová data k již vytvořenému seznamu
děkuji za rady a přikládám vzorový soubor

Příloha: xlsx41973_pokus.xlsx (13kB, staženo 17x)
Zaslat odpověď >

#041978
elninoslov
Makrom ? Prázdne riadky nemusíte mazať, to sa urobí samé. Stačí iba uložiť súbor.
Sub Nove_data_do_DB()
Dim DA(), RA As Long, DB(), RB As Long, i As Long, rngDel As Range, ColB As New Collection, Vsetko As String, Polozka, PocetNovych As Long

With wsTabA
RA = .Cells(Rows.Count, 1).End(xlUp).Row - 2
If RA = 0 Then Exit Sub
ReDim DA(1 To RA, 1 To 5)
DA = .Cells(3, 1).Resize(RA, 5).Value2
End With

With wsTabB
RB = .Cells(Rows.Count, 1).End(xlUp).Row - 2
If RB > 0 Then
ReDim DB(1 To RB, 1 To 5)
DB = .Cells(3, 1).Resize(RB, 5).Value2
For i = 1 To RB
ColB.Add i, Join(Array(DB(i, 1), DB(i, 2), DB(i, 3), DB(i, 4), DB(i, 5)), "•")
Next i
End If
End With

Erase DB
On Error Resume Next

With wsTabA
For i = 1 To RA
Vsetko = Join(Array(DA(i, 1), DA(i, 2), DA(i, 3), DA(i, 4), DA(i, 5)), "•")

Select Case Len(Vsetko)
Case 4
If rngDel Is Nothing Then Set rngDel = .Cells(i + 2, 1).Resize(, 5) Else Set rngDel = Union(rngDel, .Cells(i + 2, 1).Resize(, 5))
Case Else
Polozka = ColB(Vsetko)
If Err.Number <> 0 Then
PocetNovych = PocetNovych + 1
ReDim Preserve DB(1 To 5, 1 To PocetNovych)
DB(1, PocetNovych) = DA(i, 1): DB(2, PocetNovych) = DA(i, 2): DB(3, PocetNovych) = DA(i, 3): DB(4, PocetNovych) = DA(i, 4): DB(5, PocetNovych) = DA(i, 5)
Err.Clear
End If
End Select
Next i
End With

On Error GoTo 0

If PocetNovych > 0 Then wsTabB.Cells(RB + 3, 1).Resize(PocetNovych, 5).Value2 = WorksheetFunction.Transpose(DB)
If Not rngDel Is Nothing Then rngDel.Delete Shift:=xlUp
End Sub


Skúšajte to výhradne na fyzickej kópii súboru !!!citovat
#042002
fudy
elninoslov díky za odpověď, ale bohužel makro nefunguje v jiném sešitu, možná je chyba mezi klávesnicí a židlí. nicméně nepotřebuju smazat prázdné řádky po uložení, jen se mi jednalo o zkopírování nových dat s jednoho listu do listu druhého.pozn:poslal jsem Vám mailcitovat

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