Hallo liebe Excel- Gemeinde.
hier ein auszug aus meinem code. ich hab mich im archiv umgesehen, doch leider nichts vergleichbares gefunden. könntet ihr mir weiterhelfen meinen code etwas zu verbessern? ich hab mich informiert und mir sagen lass, dass die Nutzung der Zwischenablage nicht empfehlenswert sei. Vielen dank vorab.
Es wird eine Mappe geöffnet und aus dieser werte entnommen. Diese Werte werden in "ThisWorkbook" eingefügt, allerdings immer von einer aktiven Zelle ausgehend.(Diese kehrt immer wieder an den gleichen Punkt zurück) ... Es geht auf jeden Fall eleganter
Dim filetoopen As String
Application.ScreenUpdating = False
ChDrive "U:\"
ChDir "U:\Befundungen"
filetoopen = Application.GetOpenFilename("Excel Files(*.xls), *.xls")
If filetoopen "False" And filetoopen "Falsch" And filetoopen "" Then
Workbooks.Open filetoopen
End If
'Beginn des Kopiervorgangs
'***************************
With ActiveWorkbook
'Zylinder- Nr.
'****************************
.Sheets("Befundung").Range("A26").Copy
ThisWorkbook.Activate
ActiveCell.Offset(0, 15).Activate
Activesheet.Paste
ActiveCell.Offset(0, -15).Activate
.Sheets("Befundung").Range("A27").Copy
ThisWorkbook.Activate
ActiveCell.Offset(1, 15).Activate
Activesheet.Paste
ActiveCell.Offset(-1, -15).Activate
.Sheets("Befundung").Range("A28").Copy
ThisWorkbook.Activate
ActiveCell.Offset(2, 15).Activate
Activesheet.Paste
ActiveCell.Offset(-2, -15).Activate
.Sheets("Befundung").Range("A29").Copy
ThisWorkbook.Activate
ActiveCell.Offset(3, 15).Activate
Activesheet.Paste
ActiveCell.Offset(-3, -15).Activate
.Sheets("Befundung").Range("A30").Copy
ThisWorkbook.Activate
ActiveCell.Offset(4, 15).Activate
Activesheet.Paste
ActiveCell.Offset(-4, -15).Activate
.Sheets("Befundung").Range("A31").Copy
ThisWorkbook.Activate
ActiveCell.Offset(5, 15).Activate
Activesheet.Paste
ActiveCell.Offset(-5, -15).Activate
.Sheets("Befundung").Range("A32").Copy
ThisWorkbook.Activate
ActiveCell.Offset(6, 15).Activate
Activesheet.Paste
ActiveCell.Offset(-6, -15).Activate
.Sheets("Befundung").Range("A33").Copy
ThisWorkbook.Activate
ActiveCell.Offset(7, 15).Activate
Activesheet.Paste
ActiveCell.Offset(-7, -15).Activate
Danke!