Daten per VBA kopieren
#1
Hallo zusammen, ich mal wieder Smile

folgendes Problem habe ich aktuell:
Aus Datei daten.xlsx kommen Daten in folgender Weise.
Spalte a (immer unterschiedlich lang) soll kopiert werden und in Datei 2 ein Teil davon (ab 2. Stelle 4 Zeichen) in Spalte a wieder eingefügt werden.
Spalte b (immer unterschiedlich lang - auch nicht mit a identisch lang) soll kopiert werden (Zahlenwerte mit mehreren Nachkommastellen) und dann auf eine Stelle gerundet in Datei 2 in Spalte b eingefügt werden.
Der Makrorecorder gibt mir folgenden Code aus:
Code:
Option Explicit
Sub Makro3()
'
' Makro3 Makro
'

'
   Windows("daten.xlsx").Activate
   Range("A2").Select
   Range(Selection, Selection.End(xlDown)).Select
   Selection.Copy
   Windows("Mappe2").Activate
   Range("C2").Select
   ActiveSheet.Paste
   Range("D2").Select
   Application.CutCopyMode = False
   ActiveCell.FormulaR1C1 = "=MID(RC[-1],2,5)"
   Range("D2").Select
   Selection.AutoFill Destination:=Range("D2:D25")
   Range("D2:D25").Select
   Range("D2").Select
   Range(Selection, Selection.End(xlDown)).Select
   Selection.Copy
   Range("A2").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Range("C2:D25").Select
   Application.CutCopyMode = False
   Selection.ClearContents
   Windows("daten.xlsx").Activate
   Range("B2").Select
   Range(Selection, Selection.End(xlDown)).Select
   Selection.Copy
   Windows("Mappe2").Activate
   Range("E2").Select
   ActiveSheet.Paste
   Range("F2").Select
   Application.CutCopyMode = False
   ActiveCell.FormulaR1C1 = "=ROUND(RC[-1],1)"
   Range("F2").Select
   Selection.AutoFill Destination:=Range("F2:F25")
   Range("F2:F25").Select
   Range("F2").Select
   Range(Selection, Selection.End(xlDown)).Select
   Selection.Copy
   Range("B2").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Range("E2:F25").Select
   Application.CutCopyMode = False
   Selection.ClearContents
End Sub

geht das auch ohne die Hilfsspalten und irgendwie schicker? Smile

LG und Danke schonmal
Top
#2
Hallöchen,

hier mal ein Beispiel zum Runden:

Code:
Sub Gerundet()
'Variablendeklaration
'Variant-Array, Long
Dim arrAA, iCnt&
'Daten in Array holen
arrAA = Range("A1:A2")
'Schleife ueber alle Elemente des Array
For iCnt = 1 To UBound(arrAA)
 'Inhalt auf 2 Stellen runden
 arrAA(iCnt, 1) = Round(arrAA(iCnt, 1), 2)
'Ende Schleife ueber alle Elemente des Array
Next
'Array in Bereich einfuegen
Range("A1:A2") = arrAA
End Sub
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste