kopieren mehrerer Spalten in variable Dateien
22.11.2017 08:29:01
Tim
leider habe ich bei meiner Suche noch keinen passende Antwort finden können, daher hoffe ich hier eine Lösung zu bekommen. Und zwar hätte ich gerne ein Modul, dass Spalten/Zeileninhalte von zwei variierenden Arbeitsmappen B (SVN), C (TCM) kopiert, in eine "Haupt-"Arbeitmappe A einfügt, Daten berechnet und Anschließend in Mappe C zurück kopiert.
zusätzliche Infos:
- A genannt "Tool", bleibt immer dieselbe Datei. Verwendetes Sheet "Tool".
- B genannt SVN, Pfad und Name ist variierenden doch der Aufbau bleibt derselbe. Verwendetes Sheet "Total Report".
- C genannt TCM, Pfad und Name ist variierenden doch der Aufbau bleibt derselbe. Verwendetes Sheet "Report".
Ablauf:
1. Öffne A
2. Button_Click (Start)-> Userform wird geöffnet, womit der Benutzer aufgefordert wird die Dateipfade von B und C auszuwählen. Mit Button_Click (OK) werden die Pfade in die Zellen "W5"=SVN-Pfad und "W6"=TCM-Pfad übergeben.
3. Button_Click (Read_Data) -> läuft ein Makro, welches die Spalten "B:H" ab Zeile 8+ von Mappe B und die Spalten "B:C" ab Zeile 8+ von Mappe C, in A kopiert.
4. Diese Daten werden dann mittels hinterlegter Formeln berechnet und in die Spalten "Q:R" ab Zeile 5+, in A abgelegt.
5. Diese Beiden Spalten "Q:R" ab Zeile 5+ sollen dann wieder in die Mappe C in die Spalten "F:G" ab Zeile 8+ zurückkopieren werden.
Frage:
Wie bekomme ich den Schritt 5 hin? Hierbei kommen immer wieder Fehler auf, entweder weil die Mappe C bereits geöffnet ist oder die Typen unverträglich sind oder kopiert ohne Inhalt usw.
Ich wäre euch sehr Dankbar wenn ihr mir weiterhelfen könntet.
Option Explicit
Function IsWorkbookOpen(ByVal strName As String) As Boolean
On Error Resume Next
IsWorkbookOpen = Not Workbooks(strName) Is Nothing
End Function
Sub Read_Data()
' Copy_Into_Tool
'Application.Calculation = xlCalculationManual 'Berechnung deaktiviert
Dim File As Variant
Dim Filename As Variant
Dim wbTool As Workbook 'WB Zieldatei Tool
Dim wsTool As Worksheet 'WS Zieldatei
Dim wbSVN As Workbook 'WB 1. Quelldatei SVN
Dim wsSVN As Worksheet 'WS 1. Quelldatei
Dim wbTCM As Workbook 'WB 2. Quelldatei TCM
Dim wsTCM As Worksheet 'WS 2. Quelldatei
Dim strPfad1 As String 'SVN Pfad
Dim strPfad2 As String 'TCM Pfad
Dim strSVN As Variant
Dim strQuelle1 As String
Dim strTCM As Variant
Dim strQuelle2 As String
Dim Total_Report As Object
Dim Report As Object
Dim Workbooks As Object
strPfad1 = ""
strSVN = Trim(Range("W5").Text) 'Zelle W5 steht Pfad von SVN
strQuelle1 = strPfad1 & strSVN
strPfad2 = ""
strTCM = Trim(Range("W6").Text) 'Zelle W6 steht Pfad TCM
strQuelle2 = strPfad2 & strTCM
'wbTool = ThisWorkbook 'Mappe "Tool" mit Code
'wsTool = wbTool.Worksheets("Tool")
'wbSVN = Workbooks.Open(strSVN & strPfad1)
'wsSVN = wbSVN.Worksheets("Total_Report")
'wbTCM = Workbooks(strTCM)
'wsTCM = wbTCM.Worksheets("Report")
'Copy_From_SVN
strPfad1 = ThisWorkbook.Worksheets("Tool").Range("W5").Value
Application.ScreenUpdating = False
Application.StatusBar = "Der Vorgang wird u.U. einige Minuten dauern. Geduld bitte!"
Application.DisplayAlerts = False
'Kopiert Spalten ab B8:H8 von SVN in Tool ab B5:H5
With Application.Workbooks.Open(Filename:=strQuelle1)
.Worksheets("Total Report").Range("B8:H8").End(xlUp).Copy _
Destination:=ThisWorkbook.Worksheets("Tool").Range("B5")
Range("B8:H8").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ThisWorkbook.Worksheets("Tool").Activate
Range("B5").Select
ActiveSheet.Paste
Application.CutCopyMode = False
If IsWorkbookOpen(strQuelle1) = True Then
wbSVN.Activate
ActiveWorkbook.Close SaveChanges:=False
End If
End With
'Copy_From_TCM
strPfad2 = ThisWorkbook.Worksheets("Tool").Range("W6").Value
'Kopiert Spalten B8:C8 von TCM in Tool L5:M5
With Application.Workbooks.Open(Filename:=strQuelle2)
.Worksheets("Report").Range("B8:C8").End(xlUp).Copy _ _
Destination:=ThisWorkbook.Worksheets("Tool").Range("L5")
Range("B8:C8").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ThisWorkbook.Worksheets("Tool").Activate
Range("L5").Select
ActiveSheet.Paste
Application.CutCopyMode = False
If IsWorkbookOpen(strQuelle2) = True Then
wbTCM.Activate
Workbooks("wbTCM").Close SaveChanges:=False
End If
End With
'Application.Calculation = xlCalculationAutomatic 'Berechnung aktiviert
' ////////// Funtioniert bis hier /////////////
'Copy_To_TCM
'Hier sollen die Spalten ab Q5:R5 von der Zieldatei Tool in TCM ab F8:G8 kopiert werden
ThisWorkbook.Worksheets("Tool").Range("Q5:R5").End(xlUp).Copy
If IsWorkbookOpen(strQuelle2) = False Then
Application.Workbooks.Open (strQuelle2)
Worksheets("Report").Range("F8").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
Application.DisplayAlerts = True
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub