< návrat zpět

MS Excel


Téma: Chyba v kódu 2 rss

Zaslal/a 21.9.2013 14:11

Prosím o další pomoct s chybkou v kódu. Trošku jsem si pohrál, ale někde mám problém. Potřebuji kódem zkopírovat buňky B6:CPR6 v řádku a vložit do jiného listu. Jen mě to nějak nefunguje. Zkoušel jsem to záznamem makra, což je v pohodě, ale při vkládání do cílového sešitu potřebuji, aby se kopírované buňky vložily do dalšího volného řádku, to ale nedám:-(Problém určitě bude v tomto: Worksheets("Databáze nabídek").Cells(radek, 3) = Worksheets("Pom list").Range("C6:CPR6")
Přikládám ukázku.
Tlačítko pro export je v listu Nabídka.
Prosím o pomoct

Sub Export_do_databaze()
ActiveWorkbook.Save

Dim zdroj As String
zdroj = ActiveWorkbook.Name

Dim c_Nabidky As String
c_Nabidky = Worksheets("Nabídka").Cells(13, 18).Value ' Číslo nabídky

With Worksheets("Databáze nabídek")
If Application.WorksheetFunction.CountIf(Range(.Cells(2, 2), .Cells(Columns(1).Rows.Count, 2).End(xlUp)), c_Nabidky) > 0 Then
' If Application.WorksheetFunction.CountIf(Range(.Columns(2)), c_Nabidky) > 0 Then
MsgBox "V databázi už tato nabídka existuje, je nutné změnit číslo cenové nabídky?", vbOKOnly, "Nabídka už existuje"
Else
Dim radek As Integer
radek = Worksheets("Databáze nabídek").Cells(Columns(1).Rows.Count, 2).End(xlUp).Row + 1

'Sheets("Pom list").Select
'Range("B6:CPR6").Select
'Application.CutCopyMode = False
'Selection.Copy
'Sheets("Databáze nabídek").Select
'Range("B13").Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Databáze nabídek").Cells(radek, 2) = Worksheets("Nabídka").Range("R13") 'Číslo nabídky
Worksheets("Databáze nabídek").Cells(radek, 3) = Worksheets("Pom list").Range("C6:CPR6")
MsgBox "Export do databáze byl ukončen", vbOKOnly, "Info"
End If
End With 'Worksheets("Databáze nabídek")
End Sub

Příloha: rar15365_databaze.rar (142kB, staženo 26x)
Jméno
Kontrola
Text
  b i u s img code url hr   1 2 3 4 5 6 7 8 9 10

#015366
avatar
Nahraď řádek
Worksheets("Databáze nabídek").Cells(radek, 3) = Worksheets("Pom list").Range("C6:CPR6")
tímto
Worksheets("Databáze nabídek").Range("C" & radek & ":CPR" & radek).Value = Worksheets("Pom list").Range("C6:CPR6").Value

Musíš se takto odkazovat na stejnou oblast.citovat
#015367
avatar
Děkuji za pomoc:-)citovat
#015368
avatar
Ještě prosím o pomoc s tímto:
Šla by vložit do kódu možnost, aby se přepsal stávající záznam (nebo byl řádek se záznamem vymazán a založen nový) v databázi pod číslem př. CN0023 pokud je exportována nabídka se stejným číslem CN0023?
Představa je taková, že by se zobrazilo stávající upozornění o nalezeném záznamu se stejným číslem a navíc by přibyla možnost přepsání záznamu.
Je to proveditelné?citovat
#015416
avatar
Opravdu nikdo?citovat
#015418
avatar
V příloze jsem vytvořil jednoduchý příklad využítí msgboxu pro rozhodnutí. Pokud najde číslo z listu1 na listu2 tak ho bud vymaže, nebo nechá. Zapracuj si to podle potřeby.
Příloha: zip15418_sesit1.zip (14kB, staženo 26x)
citovat
#015419
avatar
Půjde to zapracovat do výše uvedeného kódu?
Omlouvám se, že se ptám jako bl..c, ale fakt v těch kódech plavu:-(citovat
#015421
avatar
Takto?
Příloha: zip15421_databaze.zip (156kB, staženo 26x)
citovat
#015423
avatar
Super, díky ti moc...citovat
#015426
avatar
Tady je jiné řešení.
Je tam volba přepsání a smazání jak ses ptal výše.
Příloha: zip15426_databaze.zip (161kB, staženo 26x)
citovat
#015427
avatar
I tobě moc díky za pomoc...citovat

Uživatelské menu

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

Menu

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.

On-line nástroje