434 Aufrufe
Gefragt in Tabellenkalkulation von
Hallo Excel Community,
ich habe wieder ein kleines Excel-Makro-Problem:
Ich habe mit Hilfe von einem User von Euch das Makro gebastelt und
es funktioniert einwandfrei. Nun bedarf es eine Änderung und jetzt
kommt ihr ins Spiel. Hier das Makro:

[b]Private Sub CommandButton21_Click()
'Copy Makro
'
Dim lngLetzte As Long
Dim strBlatt As String
Dim wkbQuelle As Workbook
Dim bExists As Boolean
Dim bExists2 As Boolean
Dim oWorkbook As Object
Dim i As Long
If Worksheets("Check").Range("B5") = "" Then
    MsgBox "Bitte zuerst Nr. eintragen", 16, "Error!"
    Exit Sub
Else
'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False
'Name des Blattes, aus dem die Daten ausgelesen werden sollen in
Variable schreiben
strBlatt = "Daten"
' Prüfen ob Datei "Umsatz.xlsx" bereits geöffnet ist
bExists = False
With Application
  For Each oWorkbook In .Workbooks
       If UCase$(oWorkbook.Name) = "UMSATZ.XLSX" Then
      ' Jetzt aktivieren
      Set wbkQuelle = oWorkbook
      bExists = True
      Exit For
    End If
  Next
End With
'Falls Arbeitsmappe nicht geöffnet ist, dann Mappe laden!
If bExists = False Then
  Set wbkQuelle = Workbooks.Open("\\......Umsatz.xlsx")
End If

'prüfen, ob in Quelltabelle das Arbeitsblatt tatsächlich existiert
bExists2 = False

With wbkQuelle
  For i = 1 To .Worksheets.Count
    If .Worksheets(i).Name = strBlatt Then
      bExists2 = True
      Exit For
    End If
  Next i
End With

If bExists2 = False Then
 MsgBox "Daten in """ & strBlatt & """ existieren in Umsatz.xslx. nicht ",
16, "Cancellation!"
 wbkQuelle.Activate
 Exit Sub
End If

'Schaut ob die Umsatzdaten heruntergeladen wurden
If Worksheets("FS").Range("C1") = "" Then
 MsgBox "Bitte Daten zuerst herunterladen"
 Exit Sub
End If

'Daten kopieren   
wbkQuelle.Worksheets(strBlatt).Range("A1:T2000").Copy

'Inhalte und Formate werden eingefügt
With ThisWorkbook.Worksheets("Bericht").Range("A5")
 .PasteSpecial Paste:=xlPasteValues                 'Werte
 .PasteSpecial Paste:=xlPasteFormats                'Formate
End With
Application.CutCopyMode = False

'Arbeitsmappe Umsatz.xlsx wieder schließen, ohne Speicherung, falls
diese geöffnet wurde
'andernfalls bleibt die Mappe offen
If bExists = False Then wbkQuelle.Close (False)
'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True
End If
    
End Sub[/b]

Wie sollte es verändert werden? In der Datei wo das Makro
aufgerufen wird muss aus der Zelle „F10“ (Tabellenblatt "Bericht") die
Zahl herauskopiert werden und im File UMSATZ.XLSX in der Zelle
„Z12“ (nur als Wert) hinzugefügt werden, erst dann den Bereich
A1:T2000 kopieren (aus der Umsatz.xlsx-Datei) um in der Datei wo
das Makro ausgeführt wurde die Werte + Formate im Tabellenblatt
„Bericht“ ab Zelle A5 einfügen.
Wenn etwas unklar sein sollte, bitte zurückmelden.
Schon jetzt vielen Dank.
Gruß
Max

2 Antworten

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo Max,

keine Ahnung ob ich dich richtig verstanden habe.
Der Wert aus F10 wird in die Datei UMSATZ.XLSX in das Blatt "Daten" eingetragen. Eine Speicherung der geänderten UMSATZ.XLSX erfolgt nicht:

[code]Private Sub CommandButton21_Click()
Dim lngLetzte As Long
Dim strBlatt As String
Dim wkbQuelle As Workbook
Dim bExists As Boolean
Dim bExists2 As Boolean
Dim oWorkbook As Object
Dim i As Long

If Worksheets("Check").Range("B5") = "" Then
    MsgBox "Bitte zuerst Nr. eintragen", 16, "Error!"
    Exit Sub
End If

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False
'Name des Blattes, aus dem die Daten ausgelesen werden sollen in Variable schreiben
strBlatt = "Daten"
' Prüfen ob Datei "Umsatz.xlsx" bereits geöffnet ist
bExists = False
With Application
 For Each oWorkbook In .Workbooks
   If UCase$(oWorkbook.Name) = "UMSATZ.XLSX" Then
    'Jetzt aktivieren
    Set wbkQuelle = oWorkbook
    bExists = True
    Exit For
   End If
 Next
End With

'Falls Arbeitsmappe nicht geöffnet ist, dann Mappe laden!
If bExists = False Then
  Set wbkQuelle = Workbooks.Open(""\\......Umsatz.xlsx")

  'prüfen, ob in Quelltabelle das Arbeitsblatt tatsächlich existiert
   bExists2 = False

  With wbkQuelle
    For i = 1 To .Worksheets.Count
      If .Worksheets(i).Name = strBlatt Then
        bExists2 = True
        Exit For
      End If
     Next i
  End With

  If bExists2 = False Then
    MsgBox "Daten in """ & strBlatt & """ existieren in Umsatz.xslx. nicht ", 16, "Cancellation!"
    wbkQuelle.Activate
    Exit Sub
   End If
End If

'Schaut ob die Umsatzdaten heruntergeladen wurden
If Worksheets("FS").Range("C1") = "" Then
   MsgBox "Bitte Daten zuerst herunterladen"
   Exit Sub
End If

'aus aktueller Datei aus dem Arbeitsblatt Bericht den Wert der Zelle F10 in Zieldatei kopieren
wbkQuelle.Worksheets(strBlatt).Range("Z12") = ThisWorkbook.Worksheets("Bericht").Range("F10").Value

'Daten kopieren
wbkQuelle.Worksheets(strBlatt).Range("A1:T2000").Copy

'Inhalte und Formate werden eingefügt
With ThisWorkbook.Worksheets("Bericht").Range("A5")
.PasteSpecial Paste:=xlPasteValues 'Werte
.PasteSpecial Paste:=xlPasteFormats 'Formate
End With
Application.CutCopyMode = False

'Arbeitsmappe Umsatz.xlsx wieder schließen, ohne Speicherung, falls diese geöffnet wurde
'andernfalls bleibt die Mappe offen
If bExists = False Then wbkQuelle.Close (False)

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub[/code]
Gruß

M.O.
0 Punkte
Beantwortet von
Hallo M.O.

diesmal habe ich mich sofort verständlich gemacht.
Dein Makro hat wunderbar funktioniert.

Danke sehr dafür.

Grüße
Max
...