Hallo Tino
29.12.2013 13:10:23
Albert
den nachstehenden VBA-Code hast Du mir vor Monaten zur Verfügung gestellt:
Sub Werte_importieren2()
'Start des Makros erfolgt aus der Zieltabelle
'Tabelle1.Range("J5").Value = 1
Dim Pfad_lokal As String
Dim wbZiel As Workbook, wsZiel As Worksheet
Dim wbQuelle As Workbook, wsQuelle As Worksheet, rngQuelle As Range
Dim nRQ&, nRZ&
Set wsZiel = Tabelle1
Pfad_lokal = wsZiel.Range("J10").Value
'prüfen ob Datei vorhanden
If Dir(Pfad_lokal, vbNormal) = "" Then
MsgBox "Datei" & vbCr & Pfad_lokal & vbCr & "nicht gefunden", vbExclamation
Exit Sub
End If
Set wbQuelle = Workbooks.Open(Pfad_lokal)
On Error Resume Next
Set wsQuelle = wbQuelle.Worksheets("Journal")
'prüfen ob Tabelle vorhandne
If wsQuelle Is Nothing Then
MsgBox "Tabelle 'Journal' in der Datei " & vbCr & Pfad_lokal & vbCr & "nicht gefunden", _
vbExclamation
Exit Sub
End If
On Error GoTo 0
'Fehlerbehandlung
On Error GoTo ErrorHandler:
With Application
.ScreenUpdating = False
.EnableEvents = False
If Not wsQuelle Is Nothing Then
With wsQuelle
nRZ = 4 'Voreinstellung
For nRQ = 12 To 28 Step 8
nRZ = nRZ + 8 'von letzter +8 Zeilen
For Each rngQuelle In Union(.Cells(nRQ, 3), .Cells(nRQ, 9), .Cells(nRQ, 10)). _
Areas
'nur Werte
With wsZiel.Cells(nRZ, rngQuelle.Column).Resize(, rngQuelle.Columns.Count)
.Value = rngQuelle.Value
.Copy
.PasteSpecial Paste:=xlPasteFormats
End With
Next rngQuelle
Next nRQ
End With
End If
ErrorHandler:
On Error Resume Next
wbQuelle.Close SaveChanges:=False
ThisWorkbook.Activate
Application.Goto Tabelle1.Cells(15, 3)
.ScreenUpdating = True
.EnableEvents = True
End With
If Err.Number 0 Then
MsgBox Err.Description, _
vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
"Error: " & Err.Number, Err.HelpFile, Err.HelpContext
End If
End Sub
Ich habe den Code teilweise für die geänderten Erfordernisse angepasst und habe nun zwei Fragen, die ich mit meinen bescheidenen VBA-Kenntnissen nicht lösen konnte.
1) Wie ist der Code abzuändern, damit aus Spalte J ( .Cells(nRQ, 10)) auch die Formeln (und nicht nur Werte) kopiert werden.
Falls diese Variante zu kompliziert wird, wäre für meine Zwecke auch (copy and paste) des Bereichs A:J (jede achte Zeile....) zielführend.
2) Ich muss auch Werte aus einer zweiten Tabelle (von derselben Quellarbeitsmappe) importieren und habe nun Deinen Code angepasst und definiere die Quellarbeitsmappe wieder mit:
Set wbQuelle = Workbooks.Open(Pfad_lokal) - Import funktioniert, ich möchte nur die Warnmeldung vermeiden, dass Quelldatei bereits geöffnet ist.
Application.DisplayAlerts = False führt nicht zum gewünschten Ergebnis. Gibt es eine andere Möglichkeit die (bereits geöffnete) Quellarbeitsmappe zu definieren und somit diese Warnmeldung zu vermeiden?
Ich bedanke mich nochmals für Deine tolle Unterstützung und hoffe, dass ich mit meinen neuerlichen Fragen nicht lästig erscheine.
LG Albert