AW: variabel kopieren immer noch 1004
08.01.2017 11:42:03
MB12
Hallo Werner,
witzig: Ich habe ca 8 Jahre in LB gewohnt...
Hier wie gewünscht:
https://www.herber.de/bbs/user/110402.xlsx
Option Explicit
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
ByVal DirPath As String) As Long
Private Sub CommandButton1_Click()
Dim strPath As String, strFile As String, strPathNew As String, strDir As String
strFile = Range("A1").Text & " " & Range("B1").Text & " " & "Ablaufplan" & ".xlsm"
strPath = "X:\ALS\12_Projekte+VK-Preise\" & Cells(1, 5).Text & "\"
strDir = Range("A1").Text & " " & Range("B1").Text
strPathNew = strPath & strDir & "\"
If CBool(MakeSureDirectoryPathExists(strPathNew)) Then
ThisWorkbook.SaveAs Filename:=strPathNew & strFile
Else
MsgBox "Fehler beim anlegen des Pfades: " & strPath
End If
End Sub
Private Sub CommandButton2_Click()
Dim owb1 As Workbook
Dim owb2 As Workbook
Dim owb3 As Workbook
Dim lletzte As Long 'oder String?
Set owb1 = ThisWorkbook 'Arbeitsmappe mit diesem Code
Set owb2 = Workbooks.Open("C:\Users\ohne\Documents\Excel und VBA\Vorlagen AE\Vorlage _
Auftragseingangsformular1.xlsm")
Set owb3 = Workbooks.Open("C:\Users\ohne\Documents\Excel und VBA\Vorlagen AE\Vorlage _
Maschinenpreise VK_PPMS1.xlsx")
'owb1.Sheets(1).Range("P2:Q" & lletzte).Copy Beispiel
'owb2.Sheets(1).Range("J2").Paste Beispiel; aber es sollen nur die Werte kopiert _
werden; deshalb:
owb2.Worksheets("Tabelle1").Range("C5").Value = owb1.Worksheets("Ablaufplan").Range("A1").Value _
'also zuerst das Zielblatt!!
owb2.Worksheets("Tabelle1").Range("C12").Value = owb1.Worksheets("Ablaufplan").Range("I32"). _
Value 'KOM
owb2.Worksheets("Tabelle1").Range("C9").Value = owb1.Worksheets("Ablaufplan").Range("I33"). _
Value 'FAT
owb2.Worksheets("Tabelle1").Range("C11").Value = owb1.Worksheets("Ablaufplan").Range("I34"). _
Value 'LT
owb2.Worksheets("Tabelle1").Range("B19:D" & lletzte + 16).Value = owb1.Worksheets("Ablaufplan"). _
Range("B3:D" & lletzte).Value 'Fehler 1004
owb3.Worksheets("Tabelle1").Range("D2").Value = owb1.Worksheets("Ablaufplan").Range("A1").Value _
'ProjNr
owb3.Worksheets("Tabelle1").Range("B13:D27").Value = owb1.Worksheets("Ablaufplan").Range("B3: _
D17").Value 'Maschinen
End Sub
Grüßle, M.