Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Spalten kopieren


Betrifft: Spalten kopieren von: Nick
Geschrieben am: 30.09.2019 13:56:12

Hallo in die Runde,

ich habe folgenden Code, um Spalten aus einer Tabelle zu kopieren und in eine andere einzufügen. Hat jemand einen Idee, wie ich die Spalten ab Zeile 3 kopieren und ab Zeile 3 einfügen kann?

Besten Dank und LG Nick

Sub spalten_kopieren()

Workbooks("Mappe1.xlsm").Worksheets("Tabelle1").Columns("A:B").Value = Workbooks("Mappe2.xlsx"   _
_
_
).Worksheets("Tabelle1").Columns("C:D").Value

End Sub

  

Betrifft: AW: Spalten kopieren von: Daniel
Geschrieben am: 30.09.2019 14:02:52

Hi
wen die Zeilen 1 und 2 befüllt sind:

Workbooks("Mappe2.xlsx").Sheets("Tabelle1").Usedrange.Columns(3).Offset(2, 0).Resize(, 2).Copy
Workbooks("Mappe1.xlsm").Sheets("Tabelle1").Range("A3").PasteSpecial xlpastevalues
Gruß Daniel


  

Betrifft: AW: Spalten kopieren von: Nick
Geschrieben am: 30.09.2019 14:31:12

Danke für deinen Vorschlag. Die Zeilen sind befüllt, aber irgendwie läuft es nicht so rund. Das Makro kopiert statt der Spalte einen 3x2 großen Ausschnitt. Außerdem handelt es sich bei der Spalte, um eine Datumsangabe. Das Datum 01.01.2011 wird in die Mappe 1 eingefügt, aber automatisch auf das Datum 02.06.1930 geändert.

LG Nick


  

Betrifft: AW: Spalten kopieren von: Daniel
Geschrieben am: 30.09.2019 14:36:59

Hi
sorry, kann ich dir leider nichts zu sagen.
bei mir funktioniert der Code mit meiner Beispieldatei wie gewünscht und was in deinen Zellen steht, weiß ich leider nicht und kann dir daher auch nicht sagen, warum das so ist.
machs so wie ich, dann funktionierts auch bei dir.
Gruß Daniel


  

Betrifft: AW: Spalten kopieren von: Dieter Klemke
Geschrieben am: 30.09.2019 20:46:29

Hallo Nick,

poste doch mal eine Beispieldatei. Daten beliebig verändert und/oder anonymisiert.

Viele Grüße
Dieter


  

Betrifft: AW: Spalten kopieren von: Nick
Geschrieben am: 01.10.2019 10:12:18

Hallo Dieter,

die beiden Dateien sind nun unter folgenden Links zu finden:

https://www.herber.de/bbs/user/132301.xlsm
https://www.herber.de/bbs/user/132302.xlsm

Ich versuche, dass die Spalten C, D, F, G und J aus der Datei "Mappe2" in die Spalten A, F, I, K und X in die Datei "Mappe1" kopiert werden. Das jeweils ab Zeile 3.

Ich danke dir dennoch, Daniel. Finde es wirklich klasse, dass es Menschen gibt, die gerne bereit sind zu helfen!
Gruß Nick


  

Betrifft: AW: Spalten kopieren von: Dieter Klemke
Geschrieben am: 01.10.2019 11:28:09

Hallo Nick,

du kannst das z.B. mit dem folgenden Programm machen (Programm-Code gehört nach "Mappe2.xlsm"):

Sub SpaltenKopieren()
  Dim i As Long
  Dim letzteZeile As Long
  Dim mappeZ_vorhanden As Boolean
  Dim spalteQ As String
  Dim spalteZ As String
  Dim spaltenQ As Variant
  Dim spaltenZ As Variant
  Dim wbQ As Workbook    ' Quelle
  Dim wbZ As Workbook    ' Ziel
  Dim wsQ As Worksheet
  Dim wsZ As Worksheet
  
  spaltenQ = Array("C", "D", "F", "G", "J")
  spaltenZ = Array("A", "F", "I", "K", "X")
  Set wbQ = ThisWorkbook
  Set wsQ = wbQ.Worksheets(1)
  For Each wbZ In Workbooks
    If wbZ.Name = "Mappe1.xlsm" Then
      mappeZ_vorhanden = True
      Exit For
    End If
  Next wbZ
  If Not mappeZ_vorhanden Then
    MsgBox "Bitte ""Mappe1.xlsm"" öffnen"
    Exit Sub
  End If
  Set wbZ = Workbooks("Mappe1.xlsm")
  Set wsZ = wbZ.Worksheets(1)
  For i = LBound(spaltenQ) To UBound(spaltenQ)
    spalteQ = spaltenQ(i)
    spalteZ = spaltenZ(i)
    letzteZeile = wsQ.Cells(wsQ.Rows.Count, spalteQ).End(xlUp).Row
    If letzteZeile > 3 Then
      
'      ' Alternative 1: Nur Werte kopieren
'      wsQ.Cells(3, spalteQ).Resize(letzteZeile - 2).Copy
'      wsZ.Cells(3, spalteZ).PasteSpecial Paste:=xlValues
'      Application.CutCopyMode = xlCut
    
      ' Alternative 2: Werte und Formatierungen kopieren
      wsQ.Cells(3, spalteQ).Resize(letzteZeile - 2).Copy Destination:=wsZ.Cells(3, spalteZ)
      
    End If
  Next i
End Sub
Je nach dem, ob du nur Werte oder aber Werte und Formatierungen kopieren willst, nimmst du Alternative 1 oder Alternative 2.

Viele Grüße
Dieter


  

Betrifft: AW: Spalten kopieren von: Dieter Klemke
Geschrieben am: 01.10.2019 13:38:16

Hallo Nick,

kleine Korrektur.
Es muss natürlich

    If letzteZeile > 2 Then

heißen.

Viele Grüße
Dieter


  

Betrifft: AW: Spalten kopieren von: Nick
Geschrieben am: 01.10.2019 14:08:46

Hallo Dieter,

vielen Dank für den Code! Es tut quasi genau das, was es tun soll und noch mehr mit der Aufforderung zum Öffnen der anderen Mappe.

Allerdings habe ich einen Fehler gemacht und hätte erwähnen müssen, dass es mehrere Arbeitsblätter in beiden Mappen gibt. In Mappe2 wird aus dem 6. Arbeitsblatt herauskopiert und in Mappe1 in das 3. Arbeitsblatt eingefügt. Ich habe versucht, es über das Ändern der Zahlen hinter wbQ.Worksheets und wbZ.Worksheets zu lösen. Leider fügt er so die Daten nicht mehr ein. Eine Fehlermeldung erscheint auch nicht.

LG Nick


  

Betrifft: AW: Spalten kopieren von: Dieter Klemke
Geschrieben am: 01.10.2019 16:46:08

Hallo Nick,

deiner Beschreibung nach hast du genau das Richtige gemacht. Aber im Zweifelsfall muss man immer den Code sehen.
Ich habe das Programm folgendermaßen ergänzt (am Schluss wird das Zielblatt aktiviert, um das Ergebnis zu zeigen):

Sub SpaltenKopieren()
  Dim i As Long
  Dim letzteZeile As Long
  Dim mappeZ_vorhanden As Boolean
  Dim spalteQ As String
  Dim spalteZ As String
  Dim spaltenQ As Variant
  Dim spaltenZ As Variant
  Dim wbQ As Workbook    ' Quelle
  Dim wbZ As Workbook    ' Ziel
  Dim wsQ As Worksheet
  Dim wsZ As Worksheet
  
  spaltenQ = Array("C", "D", "F", "G", "J")
  spaltenZ = Array("A", "F", "I", "K", "X")
  Set wbQ = ThisWorkbook
  Set wsQ = wbQ.Worksheets(6)
  For Each wbZ In Workbooks
    If wbZ.Name = "Mappe1.xlsm" Then
      mappeZ_vorhanden = True
      Exit For
    End If
  Next wbZ
  If Not mappeZ_vorhanden Then
    MsgBox "Bitte ""Mappe1.xlsm"" öffnen"
    Exit Sub
  End If
  Set wbZ = Workbooks("Mappe1.xlsm")
  Set wsZ = wbZ.Worksheets(3)
  For i = LBound(spaltenQ) To UBound(spaltenQ)
    spalteQ = spaltenQ(i)
    spalteZ = spaltenZ(i)
    letzteZeile = wsQ.Cells(wsQ.Rows.Count, spalteQ).End(xlUp).Row
    If letzteZeile > 2 Then
      
'      ' Alternative 1: Nur Werte kopieren
'      wsQ.Cells(3, spalteQ).Resize(letzteZeile - 2).Copy
'      wsZ.Cells(3, spalteZ).PasteSpecial Paste:=xlValues
'      Application.CutCopyMode = xlCut
    
      ' Alternative 2: Werte und Formatierungen kopieren
      wsQ.Cells(3, spalteQ).Resize(letzteZeile - 2).Copy Destination:=wsZ.Cells(3, spalteZ)
      
    End If
  Next i
  wsZ.Activate
End Sub

Anstelle der Nummern kannst du auch die Blattnamen verwenden. Wenn das 6. Blatt von Mappe2 z.B. "Kosten" heißt, dann schreibst du anstelle von
Set wsQ = wbQ.Worksheets(6)

das Statement
Set wsQ = wbQ.Worksheets("Kosten")
https://www.herber.de/bbs/user/132314.xlsm

Viele Grüße
Dieter


  

Betrifft: AW: Spalten kopieren von: Nick
Geschrieben am: 02.10.2019 08:35:14

Guten Morgen,

es läuft genau so, wie es soll! Vielen Dank dafür!

LG Nick


Beiträge aus dem Excel-Forum zum Thema "Spalten kopieren"