Poraďte prosím, je to makrem proveditelné? :-(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: Kopie formuláře
MS Excel
Téma: Kopie formuláře 
Zaslal/a Petrden 21.4.2013 16:55
Další problémek. Potřeboval bych makrem udělat kopii formuláře o třech sloupcích, ale aby bylo makrem vybrány pouze řádky z formuláře, kde je obsazená buňka ve sloupci H a ostatní ignorovat
Potřebuji mít čistý formulář bez mezer (prázdných řádků) pro další použití. Viz příloha. Prosím o pomoc s tímto...
Příloha: 
13012_kopie-formulare.rar (10kB, staženo 18x)
13012_kopie-formulare.rar (10kB, staženo 18x)
Sub subDeleteRows()
Dim rForm As Range
Set rForm = Range("E2:H22")
Dim lCalc As Long
lCalc = Application.Calculation
Application.Calculation = False
Dim bScreen As Boolean
bScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
With Range("E26").Resize(rForm.Rows.Count, rForm.Columns.Count)
.Value = rForm.Value
Dim I As Integer
For I = .Rows.Count To 1 Step -1
If IsEmpty(.Rows(I).Cells(4)) Or .Rows(I).Cells(4).Value = 0 Then
If Not IsEmpty(.Rows(I).Cells(1)) Then
.Rows(I).Cells(1).Offset(1, 0).Value = .Rows(I).Cells(1).Value
End If
.Rows(I).Delete Shift:=xlUp
End If
Next I
End With 'Range("26").Resize(rForm.Rows.Count, rForm.Columns.Count)
Application.ScreenUpdating = True
Application.Calculation = lCalc
Set rForm = Nothing
End Subcitovat
Dim rForm As Range
Set rForm = Range("E2:H22")
Dim lCalc As Long
lCalc = Application.Calculation
Application.Calculation = False
Dim bScreen As Boolean
bScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
With Range("E26").Resize(rForm.Rows.Count, rForm.Columns.Count)
.Value = rForm.Value
Dim I As Integer
For I = .Rows.Count To 1 Step -1
If IsEmpty(.Rows(I).Cells(4)) Or .Rows(I).Cells(4).Value = 0 Then
If Not IsEmpty(.Rows(I).Cells(1)) Then
.Rows(I).Cells(1).Offset(1, 0).Value = .Rows(I).Cells(1).Value
End If
.Rows(I).Delete Shift:=xlUp
End If
Next I
End With 'Range("26").Resize(rForm.Rows.Count, rForm.Columns.Count)
Application.ScreenUpdating = True
Application.Calculation = lCalc
Set rForm = Nothing
End Subcitovat
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