Microsoft Office Forum [ www.Office-Fragen.de ] >> READONLY <<

Microsoft Office 2003-2019 => Excel => Thema gestartet von: Obelix am Februar 03, 2015, 11:15:07 Vormittag

Titel: Excel 2010 VBA Filldown mit einem Range
Beitrag von: Obelix am Februar 03, 2015, 11:15:07 Vormittag

Sehr geehrte Damen und Herren,

ich bin gerade dabei ein UserForm zu programmieren. Beim "Speichern" werden in verschiedenen Tabellen Werte
eingefügt und auch Formeln runter kopiert. Leider funktioniert die "Filldown" Methode nicht. Es gibt immer den Lauffehler "1004" aus.
Beim Debuggen wird immer die Zeile
Worksheets("Daten EK").Range(Cells(lngLz, 2), Cells(lngLz +2, 46)).Filldown
angezeigt.

Weiß jemand, ob Filldown mit dem Bereich nicht zurecht kommt?

Kompletter Code:

Private Sub Speichern_Click()

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

Dim lngLz


If Not Worksheets("AT REF").Range("C:C").Find(txt_OpelNr) Is Nothing Then
    MsgBox "Artikel in AT REF vorhanden!", vbExclamation
Else

'*********************************************************************************************************************************************
'** Einfügen in AT REF

    lngLz = Worksheets("AT REF").Cells(Rows.Count, 1).End(xlUp).Row

    Worksheets("AT REF").Cells(lngLz + 1, 1) = CLng(txt_ExArtikelNr)
    Worksheets("AT REF").Cells(lngLz + 1, 2) = CInt(cbo_WG)
    Worksheets("AT REF").Cells(lngLz + 1, 3) = CLng(txt_OpelNr)
    Worksheets("AT REF").Cells(lngLz + 1, 4) = CLng(txt_ExArtikelNr)
    If chk_Pfand Then
      Worksheets("AT REF").Cells(lngLz + 2, 1) = txt_ExArtikelNr & "-P"
      Worksheets("AT REF").Cells(lngLz + 2, 2) = 99
      Worksheets("AT REF").Cells(lngLz + 2, 4) = txt_ExArtikelNr & "-P"
    End If
'*********************************************************************************************************************************************


'*********************************************************************************************************************************************
'** Einfügen in VH Preis

    If Not Worksheets("VH Preis").Range("B:B").Find(txt_OpelNr) Is Nothing Then
      MsgBox "Artikel in VH Preis schon vorhanden!", vbExclamation
    Else
      lngLz = Worksheets("Vh Preis").Cells(Rows.Count, 1).End(xlUp).Row
     
      Worksheets("VH Preis").Cells(lngLz + 1, 1) = "OP-" & txt_OpelNr
      Worksheets("VH Preis").Cells(lngLz + 1, 2) = CLng(txt_OpelNr)
      Worksheets("VH Preis").Cells(lngLz + 1, 7) = CDbl(txt_VhPreis)
    End If
'*********************************************************************************************************************************************


'*********************************************************************************************************************************************
'** Einfügen in Daten VK

    lngLz = Worksheets("Daten VK").Cells(Rows.Count, 1).End(xlUp).Row
   
    Worksheets("Daten VK").Cells(lngLz + 1, 1) = CLng(txt_ExArtikelNr)
    Worksheets("Daten VK").Cells(lngLz + 1, 2) = CInt(cbo_WG)
    Worksheets("Daten VK").Cells(lngLz + 1, 3) = CLng(txt_OpelNr)
    Worksheets("Daten VK").Cells(lngLz + 1, 4) = CDbl(txt_Gewicht)
    Worksheets("Daten VK").Cells(lngLz + 1, 5) = txt_Beschreibung_Boerse
    Worksheets("Daten VK").Cells(lngLz, 6).Copy Destination:=Worksheets("Daten VK").Cells(lngLz + 1, 6)
    Worksheets("Daten VK").Cells(lngLz + 1, 7).Value = CInt(txt_Rabatt)
    Worksheets("Daten VK").Cells(lngLz, 8 ).Copy Destination:=Worksheets("Daten VK").Cells(lngLz + 1, 8 )
    Worksheets("Daten VK").Cells(lngLz, 13).Copy Destination:=Worksheets("Daten VK").Cells(lngLz + 1, 13)
    Worksheets("Daten VK").Cells(lngLz + 1, 14) = 5
   
    If opt_Garantie_1J Then
      Worksheets("Daten VK").Cells(lngLz + 1, 15) = "GVO Original AT, Verfügbarkeit auf Anfrage,  Standard frei Haus, 1 Jahr Gewährleistung"
    ElseIf opt_Garantie_1J_2J Then
      Worksheets("Daten VK").Cells(lngLz + 1, 15) = "GVO Original AT, Verfügbarkeit auf Anfrage, Standard frei Haus, 1-2 Jahre Gewährleistung"
    ElseIf opt_Garantie_2J Then
      Worksheets("Daten VK").Cells(lngLz + 1, 15) = "GVO Original AT, Verfügbarkeit auf Anfrage, Standard frei Haus, 2 Jahre Gewährleistung"
    End If
'*********************************************************************************************************************************************
 
 
'*********************************************************************************************************************************************
'** Einfügen in Daten EK

    lngLz = Worksheets("Daten EK").Cells(Rows.Count, 1).End(xlUp).Row

    Worksheets("Daten EK").Cells(lngLz + 1, 1) = CLng(txt_ExArtikelNr)
    If chk_Pfand Then
      Worksheets("Daten EK").Cells(lngLz + 2, 1) = txt_ExArtikelNr & "-P"
      Worksheets("Daten EK").Range(Cells(lngLz, 2), Cells(lngLz +2, 46)).Filldown
    Else
      Worksheets("Daten EK").Range(Cells(lngLz, 2), Cells(lngLz +1, 46)).Filldown
    End If
'*********************************************************************************************************************************************


End If


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


End Sub

Titel: Antw: Excel 2010 VBA Filldown mit einem Range
Beitrag von: kgs-ks am Februar 18, 2015, 09:30:05 Vormittag

Hallo

mir ist aufgefallen, dass  mehrere Spalten "auf einmal " betroffen sind
        Worksheets("Daten EK").Range(Cells(lngLz, 2), Cells(lngLz +2, 46)).Filldown

vielleicht alle Spalten separat mit filldown bearbeiten

kgs

Titel: Antw: Excel 2010 VBA Filldown mit einem Range
Beitrag von: Obelix am Februar 19, 2015, 09:37:06 Vormittag

Hallo kgs-ks,

habe ich alles schon ausprobiert, leider kein Erfolg gehabt.
Das eizige was funktioniert ist .copy mit einer For-Schleife.

Mit dem Makrorecoder aufgenommem, kommt die .FillDown mit dem
kompletten Range. Vielleicht muß man das Worksheet vorher Selektieren oder aktivieren.
Werde ich noch ausprobieren.