Thema Datum  Von Nutzer Rating
Antwort
25.08.2023 07:03:20 Mario
Solved
25.08.2023 07:43:54 Gast78923
NotSolved
25.08.2023 08:44:10 volti
NotSolved
25.08.2023 08:54:53 Gast16419
NotSolved
Rot VBA Fehler
25.08.2023 09:57:48 volti
Solved
25.08.2023 10:47:08 Gast92677
NotSolved
27.08.2023 11:48:14 Gast01287
NotSolved
29.08.2023 13:26:26 AuchMalGast
NotSolved
29.08.2023 13:34:11 ANONYM
NotSolved
29.08.2023 15:27:57 Mase
NotSolved
29.08.2023 15:29:34 ANONYM
NotSolved

Ansicht des Beitrags:
Von:
volti
Datum:
25.08.2023 09:57:48
Views:
242
Rating: Antwort:
 Nein
Thema:
VBA Fehler

Hallo,

zwei ungetestete Vorschläge.

Der zweite Vorschlag nimmt nur die Werte per Dirketübernahme, wenn Dir nur die Werte reichen.

 

Teste mal, ob es klappt....

Code:
01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
 
Option Explicit

Sub Daten_Finance_Review1()
' erteund Formate
  Dim wbZiel As Workbook, strPath As String, i As Long

  strPath = ActiveWorkbook.Path
  Application.ScreenUpdating = False
  Set wbZiel = Workbooks.Open("R:\Jahresabschluss_DD\JA2023\Finance Review\04_Master für mtl und jährliches Finance Review\Finance Review_Master.xlsx") 
      

  With ThisWorkbook.Worksheets("Daten")
      For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
          .Cells(i, "A").Resize(, 268).Copy
          With wbZiel.Sheets("Master Data").Range("d4")
              .PasteSpecial Paste:=xlValues
              .PasteSpecial Paste:=xlFormats
          End With
          wbZiel.SaveAs Filename:=strPath & "\" & .Cells(i, "jj")
      Next i
  End With
  Set wbZiel = Nothing
  Application.ScreenUpdating = True
End Sub

Sub Daten_Finance_Review2()
' Nur Werte
  Dim wbZiel As Workbook, strPath As String, i As Long

  strPath = ActiveWorkbook.Path
  Application.ScreenUpdating = False
  Set wbZiel = Workbooks.Open("R:\Jahresabschluss_DD\JA2023\Finance Review\04_Master für mtl und jährliches Finance Review\Finance Review_Master.xlsx") 
      

  With ThisWorkbook.Worksheets("Daten")
      For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
          .Cells(i, "A").Resize(, 268).Copy
          wbZiel.Sheets("Master Data").Range("d4").Resize(, 268).Value _
                       = .Cells(i, "A").Resize(, 25).Value
          wbZiel.SaveAs Filename:=strPath & "\" & .Cells(i, "jj")
      Next i
  End With
  Set wbZiel = Nothing
  Application.ScreenUpdating = True
End Sub
_________
viele Grüße
Karl-Heinz

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
25.08.2023 07:03:20 Mario
Solved
25.08.2023 07:43:54 Gast78923
NotSolved
25.08.2023 08:44:10 volti
NotSolved
25.08.2023 08:54:53 Gast16419
NotSolved
Rot VBA Fehler
25.08.2023 09:57:48 volti
Solved
25.08.2023 10:47:08 Gast92677
NotSolved
27.08.2023 11:48:14 Gast01287
NotSolved
29.08.2023 13:26:26 AuchMalGast
NotSolved
29.08.2023 13:34:11 ANONYM
NotSolved
29.08.2023 15:27:57 Mase
NotSolved
29.08.2023 15:29:34 ANONYM
NotSolved