Microsoft Excel

Herbers Excel/VBA-Archiv

Werte von einem File in ein anderes Kopieren


Betrifft: Werte von einem File in ein anderes Kopieren
von: MarC
Geschrieben am: 14.02.2019 08:36:30

Morgen morgen alle zusammen,

ich würde gerne wenn in der Spalte N ein X steht die Werte aus dieser Zeile (K, L, M und C) in die nächste freie Zeile eines anderen Excel Files kopieren. Die freie Zeile soll automatisch bevor die Werte übertragen werden erzeugt werden. Den Wert von K sollte in die Spalte C kopiert werden, L in die Spalte D, M in die Spalte F und C in die Spalte G.

Den Code um eine neue freie Zeile zu erzeugen habe ich schon:

    Dim LRow As Integer     'Merker für leere Zeile

    With ThisWorkbook.Worksheets("Adressen")
        LRow = .Cells(.Rows.Count, 3).End(xlUp).Row + 1       'Suche in Spalte C
        .Range("A" & LRow).EntireRow.Insert
        .Range("A3:K3").Copy .Range("A" & LRow)               'Kopiere Spalte A3 bis K3
    End With
Die anderen Bedingungen bekomme ich noch nicht hin. Könnte mir da jemand bitte weiterhelfen?

Gruß Marc

  

Betrifft: AW: Werte von einem File in ein anderes Kopieren
von: Daniel M.
Geschrieben am: 14.02.2019 09:47:26

Hallo Marc,

nicht getestet, da ich keine Lust hatte deine Daten nachzubauen, probier mal:

Sub Kopieren()

Dim LRow As Integer     'Merker für leere Zeile
Dim cell As Range
Dim wsCopy As Worksheet
Dim wsPaste As Worksheet

'Das Blatt, aus der kopiert werden soll
Set wsCopy = ThisWorkbook.Worksheets("Adressen")

'Das Blatt, in das eingefügt werden soll, Namen anpassen
Set wsPaste = Workbooks("Name der Zielmappe").Worksheets("Name des Zielblatts")


For Each cell In wsCopy.Columns("N").SpecialCells(xlCellTypeConstants)
   If cell = "x" Then
      With wsPaste
         LRow = .Cells(.Rows.Count, 3).End(xlUp).Row + 1       'Suche erste freie Zeile in  _
Spalte C wsPaste
         .Range("C" & LRow) = cell.Offset(0, -3)
         .Range("D" & LRow) = cell.Offset(0, -2)
         .Range("F" & LRow) = cell.Offset(0, -1)
         .Range("G" & LRow) = cell.Offset(0, -11)
      End With
   End If
Next cell


End Sub
Gruß
Daniel


  

Betrifft: AW: Werte von einem File in ein anderes Kopieren
von: MarC
Geschrieben am: 14.02.2019 11:07:58

Danke für deine Hilfe Daniel, der Code funktioniert wenn ich die Daten in die gleiche Mappe schreibe. Wenn ich habe ein anderes File als Ziel angeben kommt die Meldung "Außerhalb des Bereichs"


  

Betrifft: AW: Werte von einem File in ein anderes Kopieren
von: Daniel M.
Geschrieben am: 14.02.2019 11:26:26

Kannst du bitte etwas ausführlicher werden? Was hast du genau verändert, wie heißen deine Mappen und wie sehen die aus? Muss die Zielmappe erst geöffnet werden oder ist die bereits geöffnet?


  

Betrifft: AW: Werte von einem File in ein anderes Kopieren
von: MarC
Geschrieben am: 14.02.2019 11:55:18

Okay sry Daniel.

Also wenn ich die Daten in die gleiche Mappe kopiere funktioniert es, aber ich möchte die Daten ja in eine andere Mappe kopieren die wo anders liegt.

Set wsPaste = ThisWorkbook.Worksheets("Tabelle2")

Wenn ich deinen Code so übernehme wie er ist und nur den Pfad ändere erhalte ich diese Meldung:
"Index außerhalb des gültigen Bereichs"
Sub Kopieren()
  
  Dim LRow As Integer     'Merker für leere Zeile
  Dim cell As Range
  Dim wsCopy As Worksheet
  Dim wsPaste As Worksheet
  
  'Das Blatt, aus der kopiert werden soll
  Set wsCopy = ThisWorkbook.Worksheets("Tabelle1")
  
  'Das Blatt, in das eingefügt werden soll, Namen anpassen
  Set wsPaste = Workbooks("\\dd01.boot.com\Public\Test Datei.xlsx").Worksheets("Tabelle2")
  
  
  For Each cell In wsCopy.Columns("N").SpecialCells(xlCellTypeConstants)
     If cell = "x" Then
        With wsPaste
           LRow = .Cells(.Rows.Count, 3).End(xlUp).Row + 1       'Suche erste freie Zeile in _
  Spalte C wsPaste
           .Range("C" & LRow) = cell.Offset(0, -3)
           .Range("D" & LRow) = cell.Offset(0, -2)
           .Range("F" & LRow) = cell.Offset(0, -1)
           .Range("G" & LRow) = cell.Offset(0, -11)
        End With
     End If
  Next cell
  
  End Sub



  

Betrifft: AW: Werte von einem File in ein anderes Kopieren
von: Daniel M.
Geschrieben am: 14.02.2019 12:00:11

Ok so kannst du das andere Workbook nicht öffnen. Zwei Optionen:

1. Du hast es schon geöffnet. Dann kommt nur der Name der Tabelle ohne den Pfad in die "", also Workbook("Test Datei.xlsx")

2. Du greifst den Teil aus Bernds Code auf und öffnest die Tabelle:

Set wsPaste = Workbooks.Open("C:\Test\Mappe2.xlsx").Worksheets("Tabelle2") ' Pfad der Zieldatei  _
anpassen



  

Betrifft: AW: Werte von einem File in ein anderes Kopieren
von: MarC
Geschrieben am: 14.02.2019 12:26:25

Okay danke Daniel und Bernd.

Jetzt habe ich trotzdem noch eine Frage. Ich will nicht das die Datei geöffnet wird oder wenn sie geöffnet wird dann so das ich es nicht sehe und sie danach wieder geschlossen wird. Geht das?


  

Betrifft: AW: Werte von einem File in ein anderes Kopieren
von: Daniel M.
Geschrieben am: 14.02.2019 12:32:30

Am Ende einfügen:

wsPaste.Parent.Close SaveChanges:=true
Ich gehe davon aus, dass du die Änderungen speichern willst, ansonsten wäre das Ganze ja etwas witzlos.


  

Betrifft: Vielen Dank
von: MarC
Geschrieben am: 14.02.2019 14:04:30

Vielen Dank euch beiden. Beide Varianten funktionieren =)


  

Betrifft: AW: Werte von einem File in ein anderes Kopieren
von: Bernd
Geschrieben am: 14.02.2019 09:48:38

Servus MarC,

warum erst eine neue Zelle einfügen? Liegen spezielle Formatierungen vor, oder befinden sich hinter dem Bereich noch weitere Daten?

Beispielhaft wie man die Daten kopieren könnte (ohne Zeile einfügen):

Sub Übertrag()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim intLZ1 As Integer
Dim intLZ2 As Integer
Dim i As Integer
Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("C:\Test\Mappe2.xlsx") ' Pfad der Zieldatei anpassen
Set ws1 = wb1.Sheets("Adressen") ' Tabellenblattname ggf. anpassen
Set ws2 = wb2.Sheets(1) ' Tabellenblattname der Zieldatei anpassen
intLZ1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To intLZ1
    If ws1.Cells(i, 14).Value = "x" Then
        intLZ2 = ws2.Cells(Rows.Count, 3).End(xlUp).Row + 1 ' ggf. Spaltennummer zur Ermittlung  _
der letzten Zeile anpassen!
        With ws2
            .Cells(intLZ2, 3).Value = ws1.Cells(i, "K").Value
            .Cells(intLZ2, 4).Value = ws1.Cells(i, "L").Value
            .Cells(intLZ2, 6).Value = ws1.Cells(i, "M").Value
            .Cells(intLZ2, 7).Value = ws1.Cells(i, "C").Value
        End With
    End If
Next i
Set wb1 = Nothing
Set wb2 = Nothing
Set ws1 = Nothing
Set ws2 = Nothing
End Sub
Grüße, Bernd


  

Betrifft: AW: Werte von einem File in ein anderes Kopieren
von: Bernd
Geschrieben am: 14.02.2019 12:34:22

Servus MarC,

Sub Übertrag()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim intLZ1 As Integer
Dim intLZ2 As Integer
Dim i As Integer
Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("C:\Test\Mappe2.xlsx") ' Pfad der Zieldatei anpassen
Set ws1 = wb1.Sheets("Adressen") ' Tabellenblattname ggf. anpassen
Set ws2 = wb2.Sheets(1) ' Tabellenblattname der Zieldatei anpassen
intLZ1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To intLZ1
    If ws1.Cells(i, 14).Value = "x" Then
        intLZ2 = ws2.Cells(Rows.Count, 3).End(xlUp).Row + 1 ' ggf. Spaltennummer zur Ermittlung  _
 _
der letzten Zeile anpassen!
        With ws2
            .Cells(intLZ2, 3).Value = ws1.Cells(i, "K").Value
            .Cells(intLZ2, 4).Value = ws1.Cells(i, "L").Value
            .Cells(intLZ2, 6).Value = ws1.Cells(i, "M").Value
            .Cells(intLZ2, 7).Value = ws1.Cells(i, "C").Value
        End With
    End If
Next i

wb2.Close True

Set wb1 = Nothing
Set wb2 = Nothing
Set ws1 = Nothing
Set ws2 = Nothing
End Sub
Grüße, Bernd