Die Letzten Werte übertragen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub LetzteWerteEintragen() Dim iRowS As Integer, iCol As Integer For iCol = 2 To 44 Step 7 iRowS = ActiveCell.Row - 8 Do Until Not IsEmpty(Cells(iRowS, iCol + 1)) iRowS = iRowS - 5 Loop Range(Cells(iRowS, iCol), Cells(iRowS + 4, iCol + 6)).Copy _ Cells(ActiveCell.Row, iCol) Next iCol End Sub

Hallo Leute
Habe unteren Code von Hans erhalten,läuft auch Super.
Könnte mir Bitte jemand den Code in den Code der UF einbauen ?
Sub LetzteWerteEintragen()
Dim iRowS As Integer, iCol As Integer
For iCol = 2 To 44 Step 7
iRowS = ActiveCell.Row - 8
Do Until Not IsEmpty(Cells(iRowS, iCol + 1))
iRowS = iRowS - 5
Loop
Range(Cells(iRowS, iCol), Cells(iRowS + 4, iCol + 6)).Copy _
Cells(ActiveCell.Row, iCol)
Next iCol
End Sub
Dieser Code Bitte bei Click einbauen.
Danke,Heinz


Private Sub cmdEintragen_Click()
Call DATEN_eintragen
End Sub

Sub DATEN_eintragen()
Dim rngFind As Range
Dim suchDatum As Date
Dim Zeile%, Spalte%, zeileDatum%, zeilelinie%, spalteLinie%
' Suchen nach dem Datum
suchDatum = DateSerial(Jahr, Monat, Tag)
With Sheets("WoMat")
Set rngFind = .Range("A:A").Find(What:=suchDatum, LookAt:=xlWhole)
If Not rngFind Is Nothing Then
zeileDatum = rngFind.Row
Set rngFind = Nothing
Else
MsgBox "Datum: " & suchDatum & " nicht gefunden!"
Set rngFind = Nothing
Exit Sub
End If
' Suchen nach der Zeilennummer lt. Kalenderwoche
zeilelinie = 0
For n = 2 To 1978 Step 38
If .Cells(n, 10).Value = KW Then
zeilelinie = n
Exit For
End If
Next n
If zeilelinie = 0 Then
MsgBox "Kalenderwoche " & KW & " nicht gefunden!"
Exit Sub
End If
' Suchen nach der Spaltenzahl der Linie
spalteLinie = 0
For n = 5 To 61 Step 7
If .Cells(zeilelinie - 1, n).Text = cmbLinie.Value Then
spalteLinie = n
Exit For
End If
Next n
If spalteLinie = 0 Then
MsgBox "Produktions-Linie: " & cmbLinie & " nicht gefunden!"
Exit Sub
End If
End With
' eventuellen Blattschutz aufheben
On Error Resume Next
Worksheets("WoMat").Unprotect
' Schreiben in das Tabellenblatt 'WoMat'
' Bezugszelle ist die obere linke Zelle des Tages und der Linie (Zellinhalt: SAP')
Zeile = zeileDatum - 3
Spalte = spalteLinie - 3
With Sheets("WoMat").Cells(Zeile, Spalte)
' Bezeichnungen
.Text = "SAP"
.Offset(1, 0) = "Pal.-Art"
.Offset(1, 0) = "Pal.-Art"
.Offset(2, 0) = "Mat.-Nr."
.Offset(3, 0) = "Abdecktray"
.Offset(4, 0) = "Lagentray"
.Offset(2, 6) = "Stk./Tag"
.Offset(3, 6) = "Stk./Tag"
.Offset(4, 6) = "Stk./Tag"
' Werte
.Offset(0, 1) = txtSAP ' SAP-Nummer
.Offset(0, 3) = txtArtikelBez ' Artikelbezeichnung
.Offset(1, 2) = txtPaDIN ' Palettenart
.Offset(2, 2) = txtPaMatNr ' Paletten Materialnummer
.Offset(2, 4) = txtPaTag ' Paletten pro Tag
.Offset(3, 3) = txtAbMatNr ' Abdeckplatten Materialnummer
.Offset(3, 4) = txtAbTag ' Abdeckplatten pro Tag
.Offset(4, 2) = txtPPMatNr ' PP-Platten Materialnummer
.Offset(4, 4) = txtPPTag ' PP-Platten pro Tag
End With
Worksheets("WoMat").Protect Password:="", Contents:=True, UserInterfaceOnly:=True
End Sub

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread