ListObjects (Tabellen) aus anderer Arbeitsmappe übertragen

[DerNeuling]

Huhu,

ich arbeite mit 2 Arbeitsmappen, die auf Sharepoint liegen.
Die Zielmappe soll Auswertungen in 3 verschiedenen Pivottabellen ermöglichen.
Dazu greift sie auf 3 verschiedene definierte Tabellen zu.

• Umsatz
  
• FC_Tab
  
• Gebündelt
  

Zwei Tabellen (Umsatz, FC_Tab) werden per VBA durch Daten von anderen Tabellen einer anderen Arbeitsmappe ersetzt.
Die dritte Tabelle (Gebündelt) aggreggiert beide Tabellen.

Ich habe folgende Probleme:

• extrem lange Berechnungszeiten habe. Was kann ich hier machen?
  

• Wenn ich folgenden Code nutze, bekomme ich teilweise Fehler bei der Berechnung:
  

• With Application
  
• .ScreenUpdating = False
  
• .Calculation = xlCalculationManual
  
• .EnableEvents = False
  
• End With
  

Folgenden Code habe ich in Modul1 geschrieben:
Sub Quellen()
Dim offen, wbz As Workbook
Workbooks.Open ("Quelle.xlsx")

Set offen = ActiveWorkbook

Dim q_FC As ListObject
Dim z_FC As ListObject
Dim q_RE As ListObject
Dim z_RE As ListObject
Dim ZZ As Long

Set q_FC = Sheets("Planung").ListObjects("FC")
Set q_RE = Sheets("Re").ListObjects("Umsatztabelle")
ThisWorkbook.Activate
Set z_FC = Sheets("FC_Q").ListObjects("FC_Tab")
Set z_RE = Sheets("RG._Q").ListObjects("Umsatz")


'we clean z_FC only if there is data
If Not Sheets("FC_Q").ListObjects("FC_Tab").DataBodyRange Is Nothing Then Sheets("FC_Q").ListObjects("FC_Tab").DataBodyRange.Delete
If Not Sheets("RG._Q").ListObjects("Umsatz").DataBodyRange Is Nothing Then Sheets("RG._Q").ListObjects("Umsatz").DataBodyRange.Delete


offen.Sheets("Planung").Range(q_FC.Name).Copy
Range(z_FC.Name).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
offen.Sheets("RE").Range(q_RE.Name).Copy
Range(z_RE.Name).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False


'we clean blanks
For ZZ = z_FC.DataBodyRange.Rows.Count To 1 Step -1
    If z_FC.DataBodyRange.Cells(ZZ, 4).Value = "" Then z_FC.ListRows(ZZ).Delete
Next ZZ
For ZZ = z_RE.DataBodyRange.Rows.Count To 1 Step -1
    If z_RE.DataBodyRange.Cells(ZZ, 4).Value = "" Then z_RE.ListRows(ZZ).Delete
Next ZZ


Set q_FC = Nothing
Set z_FC = Nothing
Set q_RE = Nothing
Set z_RE = Nothing
Gesamt
End Sub

Sub Gesamt()
Dim offen, wbz As Workbook
'Workbooks.Open ("Quelle.xlsx")
'Set offen = ActiveWorkbook

Dim q_FC As ListObject
Dim z_FC As ListObject
Dim q_RE As ListObject
Dim z_RE As ListObject
Dim z_Gebündelt As ListObject
Dim ZZ As Long

' Set q_FC = Sheets("Planung").ListObjects("FC")
' Set q_RE = Sheets("Re").ListObjects("Umsatztabelle")
ThisWorkbook.Activate
Set z_FC = Sheets("FC_Q").ListObjects("FC_Tab")
Set z_RE = Sheets("RG._Q").ListObjects("Umsatz")
Set z_Gebündelt = Sheets("Gebündelt_Q").ListObjects("Gebündelt")

'we clean z_FC only if there is data
' If Not Sheets("FC_Q").ListObjects("FC_Tab").DataBodyRange Is Nothing Then Sheets("FC_Q").ListObjects("FC_Tab").DataBodyRange.Delete
' If Not Sheets("RG._Q").ListObjects("Umsatz").DataBodyRange Is Nothing Then Sheets("RG._Q").ListObjects("Umsatz").DataBodyRange.Delete
If Not Sheets("Gebündelt_Q").ListObjects("Gebündelt").DataBodyRange Is Nothing Then Sheets("Gebündelt_Q").ListObjects("Gebündelt").DataBodyRange.Delete


Sheets("RG._Q").Range(z_RE.Name).Copy
Range(z_Gebündelt.Name).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
Set lR = z_Gebündelt.ListRows.Add
z_FC.DataBodyRange.Copy lR.Range


Set z_FC = Nothing
Set z_RE = Nothing
Set z_Gebündelt = Nothing

End Sub


Ich freue mich über Eure Ideen!
Mfg

[Ralf A]

Ich habe folgende Probleme:

• extrem lange Berechnungszeiten habe. Was kann ich hier machen?
  

• Wenn ich folgenden Code nutze, bekomme ich teilweise Fehler bei der Berechnung:
  

• With Application
  
• .ScreenUpdating = False
  
• .Calculation = xlCalculationManual
  
• .EnableEvents = False
  
• End With
  

Hi,

weil Du neu bist, folgender Hinweis: Wenn Du schon Code postest, dann verwend bitte Code-Tags. Wer soll denn den aneinandergeklatschten Code lesen? Noch besser, füge die Datei(en) an.
Hab mir jetzt nur den oben zitierten Code angesehen. Wenn Du Application Eigenschaften auf false setzt, dann musst Du sie nach Ende der durchgeführten Aktion auch wieder auf true setzen. Calculation auf xlautomatic.
Den Rest hab ich mir aus o.g. Grund nicht angesehen.
Frage: Warum nutzt Du nicht PQ für diese Aufgabe?