Makro

Forumthread: Makro

Makro

Achim

Wer kann mir mit einem Makro helfen helfen?
Gruß Achim
https://www.herber.de/bbs/user/71081.xls

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Makro

16.08.2010 13:07:15

Klaus

Hallo Achim,

Sub KopierenNumPlanNachDispo()
Dim rNrn As Range
Dim lRow As Long
Dim lRo2 As Long
With Sheets("NMP Lang")
lRow = .Range("A65536").End(xlUp).Row
For Each rNrn In .Range("A3:A" & lRow)
lRo2 = 1 + Sheets("Disposition").Range("B65536").End(xlUp).Row
.Range("E2").Resize(1, .Range("E2").End(xlToRight).Column - 4).Copy
Sheets("Disposition").Range("F" & lRo2).PasteSpecial Transpose:=True, Paste:=xlValues
Sheets("Disposition").Range("B" & lRo2 & ":B" & lRo2 - 1 + .Range("E2").End(xlToRight). _
Column - 4).Value = rNrn.Value
Next 'rNrn
End With
With Sheets("Disposition")
.Range("A5:A" & lRo2).FormulaR1C1 = "=ROW()-4"
.Range("C5:C" & lRo2).FormulaR1C1 = "=VLOOKUP(RC[-1],'NMP Lang'!C[-2]:C[1],2,)"
.Range("D5:D" & lRo2).FormulaR1C1 = "=VLOOKUP(RC[-2],'NMP Lang'!C[-3]:C,3,)"
.Range("E5:E" & lRo2).FormulaR1C1 = "=VLOOKUP(RC[-3],'NMP Lang'!C[-4]:C[-1],4,)"
.Range("G5:G" & lRo2).FormulaR1C1 = "=TEXT(RC[-1],""TTT"")"
.Range("H5:H" & lRo2).FormulaR1C1 = _
"=IF(VLOOKUP(RC[-6],'NMP Lang'!C1:C35,MATCH(RC[-2],'NMP Lang'!R2,),)="""","""",VLOOKUP( _
RC[-6],'NMP Lang'!C1:C35,MATCH(RC[-2],'NMP Lang'!R2,),))"
End With
End Sub

Gruß,
Klaus M.vdT.

AW: Makro

16.08.2010 13:23:48

Achim

Hallo Klaus
Danke. bis auf den letzen werden alle daten in disposition übernommen und noch eine zusatzfrage. wenn in nmp lang noch mehr personen dazu kommen wo muss das makro erweitern.
gruss achim

mit dem letzen (sic!).

16.08.2010 13:31:23

Klaus

Hallo Achim,
da hatte ich einen kleinen Denkfehler. Eben erweitert so dass er alle mitnimmt:

Sub KopierenNumPlanNachDispo()
Dim rNrn As Range
Dim lRow As LoadPictureConstants
Dim lRo2 As Long
With Sheets("NMP Lang")
lRow = .Range("A65536").End(xlUp).Row
For Each rNrn In .Range("A3:A" & lRow)
lRo2 = 1 + Sheets("Disposition").Range("B65536").End(xlUp).Row
.Range("E2").Resize(1, .Range("E2").End(xlToRight).Column - 4).Copy
Sheets("Disposition").Range("F" & lRo2).PasteSpecial Transpose:=True, Paste:=xlValues
Sheets("Disposition").Range("B" & lRo2 & ":B" & lRo2 - 1 + .Range("E2").End(xlToRight). _
Column - 4).Value = rNrn.Value
Next 'rNrn
End With
With Sheets("Disposition")
lRo2 = .Range("B65536").End(xlUp).Row
.Range("A5:A" & lRo2).FormulaR1C1 = "=ROW()-4"
.Range("C5:C" & lRo2).FormulaR1C1 = "=VLOOKUP(RC[-1],'NMP Lang'!C[-2]:C[1],2,)"
.Range("D5:D" & lRo2).FormulaR1C1 = "=VLOOKUP(RC[-2],'NMP Lang'!C[-3]:C,3,)"
.Range("E5:E" & lRo2).FormulaR1C1 = "=VLOOKUP(RC[-3],'NMP Lang'!C[-4]:C[-1],4,)"
.Range("G5:G" & lRo2).FormulaR1C1 = "=TEXT(RC[-1],""TTT"")"
.Range("H5:H" & lRo2).FormulaR1C1 = _
"=IF(VLOOKUP(RC[-6],'NMP Lang'!C1:C35,MATCH(RC[-2],'NMP Lang'!R2,),)="""","""",VLOOKUP( _
RC[-6],'NMP Lang'!C1:C35,MATCH(RC[-2],'NMP Lang'!R2,),))"
End With
End Sub

Das Makro "springt" durch die .end(xlToRight) und .end(xlUp) Anweisungen bis zum letzten (untersten) Namen und letzten (recht-esten Datum). Hab ich aber nicht ausführlich getestet.
Probier bitte mal aus, ob das Makro noch macht was es soll wenn du ein dutzend oder so mehr Namen einpflegst (sollte eigentlich klappen).
Grüße,
Klaus M.vdT.

AW: mit dem letzen (sic!).

16.08.2010 16:54:48

Achim

Hallo Klaus
Danke Super geholfen.
Gruß
Achim

Danke für die Rückmeldung! o.w.T.

17.08.2010 08:05:25

Klaus

Beliebteste Forumthreads (12 Monate)

Forumthread: Makro

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread