Objekt in Sheet einfügen

Forumthread: Objekt in Sheet einfügen

Klaus

Hallo zusammen,
ich muß mit großen Excel Dateien arbeiten und dort große Bereiche zwischen den Sheets oder von anderen XLS-Dateien kopieren. Das wird schnell zu einem Geduldsspiel und dauert ewig.
Daher ist mir die Idee gekommen per VBA den zu kopierenden Bereich als Objekt zu definieren und dieses Objekt in das Zielsheet "einzufügen".
Die Definition des Objekts ist klar:
Set obj1 = ActiveSheet.Range("A10:C20")
Wie füge ich per VBA das Objekt (bzw. alle Elemente davon) in ein anderes Sheet ein?
(z. B. in Tabelle1 ab Zelle C5)
Nach Möglichkeit sollen Formeln genauso (also "=D20" soll auch danach noch "=D20" unabhängig in welcher Zelle ich Einfüge) erhalten bleiben und Werte 1:1 übernommen werden, optimal aber kein Muß wäre die Übertragung auch der Formatierung)
Vielen Dank für Euere Anregungen
Klaus

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Objekt in Sheet einfügen

Tino
sind Matrix- Formeln im Bereich...

Tino

AW: Objekt in Sheet einfügen

20.03.2010 11:45:56

Tino

Hallo,
teste mal diese Version.

Sub Test()
Dim obj1 As Range, rngZiel As Range
Dim meAr
Dim A&, AA&
Dim iCalc As Integer

Set obj1 = ActiveSheet.Range("A10:C20")

meAr = obj1.Resize(, obj1.Columns.Count + 1).FormulaLocal
Redim Preserve meAr(1 To Ubound(meAr), 1 To Ubound(meAr, 2) - 1)

On Error Resume Next
    Set rngZiel = Application.InputBox("Wählen Sie das Ziel", "Zelle auswählen", Type:=8)
On Error GoTo 0

If Not rngZiel Is Nothing Then
    With Application
        iCalc = .Calculation
        .EnableEvents = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        
        On Error GoTo ErrorH
            obj1.Copy rngZiel(1, 1)
            rngZiel.Resize(Ubound(meAr), Ubound(meAr, 2)).FormulaLocal = meAr
  
ErrorH:
        If Err.Number <> 0 Then
         MsgBox Err.Description, _
                vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
                "Error: " & Err.Number, Err.HelpFile, Err.HelpContext
        End If
        
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = iCalc
        
      End With
End If

End Sub

Gruß Tino

sind Matrix- Formeln im Bereich...

20.03.2010 15:43:19

Tino

Hallo,
, müsste es so funktionieren.

Sub Test()
Dim obj1 As Range, rngZiel As Range
Dim meAr()
Dim A&, AA&, LRow, LCol
Dim iCalc As Integer
Dim rngFormel As Range
Dim sngTimer As Single

'Quelle 
Set obj1 = ActiveSheet.Range("A10")

'Formeln in einem Array speichern 
meAr = obj1.Resize(, obj1.Columns.Count + 1).FormulaLocal
'richtige größe herstellen 
Redim Preserve meAr(1 To Ubound(meAr), 1 To Ubound(meAr, 2) - 1)

On Error Resume Next 'Fehler umgehen 
    'sind Formeln im Bereich 
    If obj1.Count > 1 Then 'mehr als eine Zelle? 
        Set rngFormel = obj1.SpecialCells(xlCellTypeFormulas)
    Else
        If obj1.HasFormula Then Set rngFormel = obj1
    End If
    
    'Ziel- Zelle wählen 
    Set rngZiel = Application.InputBox("Wählen Sie das Ziel", "Zelle auswählen", Type:=8)
On Error GoTo 0


If Not rngZiel Is Nothing Then 'keine Zelle gewählt 
    With Application
        iCalc = .Calculation
        .EnableEvents = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        
        On Error GoTo ErrorH 'Fehler abfangen 
        obj1.Copy rngZiel(1, 1) 'Bereich kopieren 
         
        If Not rngFormel Is Nothing Then 'sind Formeln vorhanden? 
                
                'Normale Formeln einfügen 
                rngZiel.Resize(Ubound(meAr), Ubound(meAr, 2)).FormulaLocal = meAr
                
                '1. Zeile und Spalte aus Quelle 
                LRow = obj1(1, 1).Row
                LCol = obj1(1, 1).Column

                'alle Formelzellen durchlaufen wegen Matrix- Formeln 
                For Each rngFormel In rngFormel
                    If rngFormel.HasArray Then 'ist dies eine Matrix- Formel? 
                        'Formel als Matrix- Formel einfügen 
                        rngFormel.Offset(rngFormel.Row - LRow, rngFormel.Column - LCol).FormulaArray = _
                                               meAr(rngFormel.Row - LRow + 1, rngFormel.Column - LCol + 1)
                    End If
                Next rngFormel
          
        End If
  
ErrorH:
        If Err.Number <> 0 Then 'Fehler aufgetreten? 
            'Fehlermeldung ausgeben 
            MsgBox Err.Description, _
                   vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
                   "Error: " & Err.Number, Err.HelpFile, Err.HelpContext
        End If

        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = iCalc
        
      End With 'Application 
End If

End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

Forumthread: Objekt in Sheet einfügen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread