Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1172to1176
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro

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

Betreff
Benutzer
Anzeige
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.
Anzeige
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.
Anzeige
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)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige