Clever-Excel-Forum

Normale Version: VBA_Daten import
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Hallo Community,

benötige eure Unterstützung, ich möchte daten von einer Tabelle in eine andere Tabelle übernehmen.

Es sind zwei identische Dateien:
Datei 1 IMPORT
Datei 2 EXPORT

aus dem EXPORT sollen die Daten in IMPORT mittels einem Knopfdruck übernommen werden.

Inhalt aus Zelle C3, C4, C5, D5, C8, B11, B12, C12, B13, C13, C14, F8, F10, F11, F12, F13, F14, B20:G20, B21:G21, B22:G22, B23:G23, B24:G24, B25:G25, B26:G26, B27:G27, B28:G28, B29:G29 (EXPORT)

sollen in die gleiche Zellen im Datei IMPORT übernommen werden.

Ab dem Bereich B20:G20, B21:G21, B22:G22, B23:G23, B24:G24, B25:G25, B26:G26, B27:G27, B28:G28, B29:G29 soll nur die übernommen werden die mit Daten belegt sind...

Beispiel es kann sein dass B20:G20, B21:G21 mit daten belegt sind und die restliche nicht.

Für die Unterstützung bedanke ich mich im Voraus...

CARLOS
Hallo Carlos,

falls Du nur Werte übernehmen willst, teste mal, ob das so hinkommt:

Code:

Sub Datenuebernahme()
  Dim rZelle As Range, sBer As String
  
  sBer = "C3, C4, C5, D5, C8, B11, B12, C12, B13, C13, C14, F8, F10, F11, F12, F13, F14, " _
       & "B20:G20, B21:G21, B22:G22, B23:G23, B24:G24, B25:G25, B26:G26, B27:G27, B28:G28, B29:G29"
 
  With Application
     .ScreenUpdating = False
     .EnableEvents = False
     .Calculation = xlCalculationManual
  End With
  
  For Each rZelle In Sheets("Export").Range(sBer)
      If Not IsEmpty(rZelle) Or rZelle.Row < 20 Then
         Sheets("Import").Range(rZelle.Address).Value = rZelle.Value
      End If
  Next
  
  With Application
     .ScreenUpdating = True
     .EnableEvents = True
     .Calculation = xlCalculationAutomatic
  End With
End Sub

_________
viele Grüße
Karl-Heinz
Hi Karl-Heinz,

ich wünsche dir ein gutes neues Jahr vor allem viel Gesundheit...

Vielen Dank für die Rückmeldung... habe probiert und ein Laufzeitfehler '9': Index außerhalb des gültigen Bereichs

gelb markiert ist: For Each rZelle In Sheets("Export").Range(sBer)

Was könnte es sein?

Vielen Dank...

CARLOS[attachment=36294]
Hallo Carlos,

funktioniert, gerade noch mal probiert.

Existiert das Blatt "Export" in der aktuellen Arbeitsmappe?
Falls eine Mappe aktiv ist, in der das Blatt Export nicht drin ist, gibt es den o.a. Fehler.

Falls es die Mappe ist, wo auch das Makro drin ist, könnte man den Code noch erweitern...
For Each rZelle In ThisWorkbook.Sheets("Export").Range(sBer)

oder Du gibst die Mappe direkt mit an

For Each rZelle In Workbooks("MeineMappe.xlsm").Sheets("Export").Range(sBer)

Ansonsten stimmt vielleicht was mit den Feldern nicht. Das kann ich ohne Mappe nicht beurteilen.

Gruß Karl-Heinz