Příspěvky uživatele

Děkuji moc oběma, systém elninoslov je úplně super, přesně, co jsem potřeboval. Ještě bych se jen zeptal, kdybych ta data nechtěl kopírovat do vedlejší záložky "Objednávky", ale to vedlejšího souboru, který je ve stejné složce, bylo by to technicky možné? Aby se soubor třeba otevřel, makro do něj poslalo daný řádek a zase se soubor zavřel a první soubor by zůstal otevřený...umožňuje to vůbec excel?

Ještě jednou moc děkuji

Dobrý den,

vedu seznam položek k objednání v listu seznam. Potřeboval bych vymyslet makro, kdy bych to kolonky "Objednat kusů" napsal počet kusů k obednání a následně kliknul na vedlejší buňku (rád bych, aby to bylo na bunku a ne na tlačítko) a tím by se údaje z dané řádky překopírovaly do vedlejšího listu s názvem "objednávky". A další, aby se štosovaly pod sebou. Dokázal by mi někdo prosím pomoci?

Děkuji moc

Díky moc, to je přesně ono, jen nevím, proč mi to ted filtruje a kopíruje data třeba ze 4 listů z 5, mělo by to ze všech...

Dobrý den, používám ten kod, který mi do nového listu překopíruje data z několika listů, potřeboval bych však mu zadat podmínku, aby kopíroval pouze řádky, které ve sloupci E obsahují určité "slovo". Nějak se s tím mořím, nevěděl by někdo?

Děkuji moc

Sub celkem()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Delete the sheet "RDBMergeSheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "RDBMergeSheet"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "RDBMergeSheet"

'Fill in the start row
StartRow = 2

'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets

'Loop through all worksheets except the RDBMerge worksheet and the
'Information worksheet, you can ad more sheets to the array if you want.
If IsError(Application.Match(sh.Name, _
Array(DestSh.Name, "Information"), 0)) Then

'Find the last row with data on the DestSh and sh
Last = LastRow(DestSh)
shLast = LastRow(sh)

'If sh is not empty and if the last row >= StartRow copy the CopyRng
If shLast > 0 And shLast >= StartRow Then

'Set the range that you want to copy
Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))

'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If

'This example copies values/formats, if you only want to copy the
'values or want to copy everything look below example 1 on this page
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

End If

End If
Next

ExitTheSub:

Application.GoTo DestSh.Cells(1)

'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End If

End Sub

Dobrý den,

nevěděl by někdo prosím, jak udělat, aby se data z listů "data1" až "data7" automaticky překopírovala a řadila na první list. Když třeba napíšu řadek v záložce "data 5", aby se automaticky zkopíroval pod poslední řádek v záložce "přehled"

Děkuji moc

Paráádní, díky moc

Dobrý den,

potřeboval bych pomocí VBA vytvořit jednoduchý katalog v excelu, kde bych v 1 listě měl vyplnovací pole (Jméno, příjmení aj...) a po kliknutí by se tyto údaje ukládaly do řádků pod sebe na nové listě a současně by se pole smazala pro nový záznam, také bych potřeboval automatické generování ID čísla podle pořadí záznamu. Pomohl by mi někdo prosím s makrem? Děkuji moc, posílám soubor

Je zamčený celý soubor heslem

Nevím jak :(

Ahoj, jde nějak ošetřit, aby se pomocí VBS souboru otevřel excelovský soubor, který má heslo? Nevím, kam heslo dát...díky moc za případné rady

Set xl = CreateObject("Excel.application")

xl.Application.Workbooks.Open "\\sitovy_disk\slozka\soubor.xlsm"

Díííky!!! To byla ta chyba, vyčištěno, opraveno, paráda, díky.

Tak jsem se pokusil to vyloupnout z toho mého velkého souboru...díky

Díky, vážně tam byla chyba a jeden řádek neměl správný formát, už to chybu nehází, ale pošle to informace jen o 1 řádku a to ještě jen o tom, který je v horní části tabulky, když expiruje třeba řádek 50, neudělá to nic....nevím, kde je chyba

Chybu mi hází řádek

If Cells(i, 25).Value = (Date + 30) Then

Ahoj, prosím o pomoc, potřebuji použít pro mou tabulku toto makro, které zkontroluje datumy v 1 sloupci a pokud odpovídají termínu dnes +30 dní, odešle údaje ze řádky na email.....vše mi funguje, jen mi to pošle údaje o jedné řádce, potom chyba 13 a hotovo....můžete mi prosím někdo poradit, kde je chyba?

Díky mooc

Sub email()

Dim ce As Range, i As Long
Dim strto As String, strcc As String, strbcc As String
Dim strsub As String, strbody As String

For i = 11 To Sheets("Katalog").Range("Y536").End(xlUp).row

If Cells(i, 25).Value = (Date + 30) Then

Dim CDO_Mail_Object As Object
Dim CDO_Config As Object
Dim SMTP_Config As Variant
Dim Email_Subject, Email_Send_From, Email_Send_To, Email_Cc, Email_Bcc, Email_Body As String
Email_Subject = ""
Email_Send_From = "Katalog" & "<xxx@xxxx.cz>"

Application.DisplayAlerts = False
Set CDO_Mail_Object = CreateObject("CDO.Message")

Set CDO_Config = CreateObject("CDO.Configuration")
CDO_Config.Load -1
Set SMTP_Config = CDO_Config.Fields
With SMTP_Config
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'please put your server name below
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "xxxxxx"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxx@xxxx.cz"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxx"

.Update
End With

Application.DisplayAlerts = False

With Sheets("Katalog")
strto = .Cells(i, 95).Value
strcc = ""
strbcc = ""
strsub = ""
strbody = ""
End With

With CDO_Mail_Object
Set .Configuration = CDO_Config
End With
CDO_Mail_Object.Subject = strsub
CDO_Mail_Object.From = Email_Send_From
CDO_Mail_Object.To = strto
CDO_Mail_Object.TextBody = strbody
CDO_Mail_Object.cc = Email_Cc 'Use if needed
CDO_Mail_Object.BCC = Email_Bcc 'Use if needed
CDO_Mail_Object.Send

End If

Next i

End Sub

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje