Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1292to1296
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Excel Zellwerte in andere Excel Datei kopieren

Excel Zellwerte in andere Excel Datei kopieren
14.01.2013 16:26:12
Alexander
Hallo zusammen!
Ich habe folgendes Problem:
Ich will aus einer Exelmappe mit dem Namen "Laufkarte_zur_Auftragsabwicklung" aus dem Tabellenblatt "Vertrieb" die Werte (Text) der folgenden Zellen über einen Makrobutton auslesen: D4, D5, D6, D7, D8, D9, D10, D11, D12, D13, M3, M4, M5, M7, M10, M11, M12, M13, L59, L60, L61, L62, L63, L64, L65.
Diese Werte sollen dann in eine Mappe mit dem Namen "Auflistung_der_Bemusterungsaufträge" im Blatt "Bemusterungsaufträge" immer unter die letzte beschriebene Zelle eingefügt werden.
Der Block soll so aussehen:
D4 D5 D6 D7 D8 L59 D9 D10 D11 D12 D13 M3 M4 M5 M7 M10 M11 M12 M13
---------------------L60
---------------------L61
---------------------L62
---------------------L63
---------------------L64
---------------------L65
(Die Minuszeichen sind nur Platzhalter, damit man die Anordnung versteht!)
Kann mir da jemand helfen?
Ich bekomme das mit dem kopieren von einer Mappe in die andere nicht hin :-(
Merci im voraus!

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Excel Zellwerte in andere Excel Datei kopieren
15.01.2013 03:36:09
fcs
Hallo Alexander,
hier ein entsprechendes Makro.
Wichtig ist hier die Verwendung von entsprechenden Objekt-Variablen für die involvierten Arbeitsmappen und Tabelleblätter, um die Kopieraktionen einfach programmieren zu können.
Das Makro ist so aufgebaut, dass die Zieldatei bei Bedarf geöffnet wird. Hier muss du ggf. noch den Pfad anpassen
Gruß
Franz
Sub BemusterungsAuftragSpeichern()
Dim wbQuelle As Workbook, wksQuelle As Worksheet
Dim wbZiel As Workbook, wksZiel As Worksheet
Dim strZiel As String, strPfadZiel As String
Dim bolOpen As Boolean
Dim Zeile_Z As Long, Zelle_Letzte As Range
If MsgBox("Bemusterungsauftrag jetzt speichern?", vbQuestion + vbOKCancel, _
"Speichern Bemusterungsauftrag") = vbCancel Then GoTo Fehler
On Error GoTo Fehler
Set wbQuelle = ActiveWorkbook 'Datei "Laufkarte_zur_Auftragsabwicklung.xlsm"
Set wksQuelle = wbQuelle.Worksheets("Vertrieb")
Application.ScreenUpdating = False
strPfadZiel = "C:\Users\Public\Test"       '### anpassen ##!!!
strPfadZiel = wbQuelle.Path                'wenn beide Dateien im gleichen Verzeichnis
strZiel = "Auflistung_der_Bemusterungsaufträge.xlsx"
If fncCheckWorkbookOpen(strZiel) Then
Set wbZiel = Application.Workbooks(strZiel)
bolOpen = True
Else
Set wbZiel = Application.Workbooks.Open(strPfadZiel & Application.PathSeparator _
& strZiel)
bolOpen = False
End If
Set wksZiel = wbZiel.Worksheets("Bemusterungsaufträge")
With wksZiel
'nächste Einfüge-Zeile ermitteln
Set Zelle_Letzte = .Cells.Find(What:="*", After:=Range("A1"), _
LookIn:=xlFormulas, lookat:=xlWhole, searchorder:=xlByRows, _
searchdirection:=xlPrevious)
If Zelle_Letzte Is Nothing Then
Zeile_Z = 1
Else
Zeile_Z = Zelle_Letzte.Row + 1
End If
'Zellinhalte übertragen - nur Werte
wksQuelle.Range("D4:D8").Copy
.Cells(Zeile_Z, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
wksQuelle.Range("L59:L65").Copy
.Cells(Zeile_Z, 6).PasteSpecial Paste:=xlPasteValues
wksQuelle.Range("D9:D13").Copy
.Cells(Zeile_Z, 7).PasteSpecial Paste:=xlPasteValues, Transpose:=True
wksQuelle.Range("M3:M5").Copy
.Cells(Zeile_Z, 12).PasteSpecial Paste:=xlPasteValues, Transpose:=True
wksQuelle.Range("M7").Copy
.Cells(Zeile_Z, 13).PasteSpecial Paste:=xlPasteValues
wksQuelle.Range("M11:M13").Copy
.Cells(Zeile_Z, 14).PasteSpecial Paste:=xlPasteValues, Transpose:=True
End With
Application.CutCopyMode = False
If bolOpen = False Then
wbZiel.Close savechanges:=True
End If
Fehler:
Application.ScreenUpdating = True
With Err
Select Case .Number
Case 0 'Alles OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
Set wbZiel = Nothing: Set wksZiel = Nothing: Set Zelle_Letzte = Nothing
Set wbQuelle = Nothing: Set wksQuelle = Nothing
End Sub
Public Function fncCheckWorkbookOpen(ByVal strName As String) As Boolean
'Prüft ob Arbeitsmappe geöffnet ist
Dim wb As Workbook
On Error GoTo Fehler
fncCheckWorkbookOpen = True
Set wb = Application.Workbooks(strName)
Fehler:
With Err
Select Case .Number
Case 0 'Alles ok
Case Else
fncCheckWorkbookOpen = False
End Select
End With
End Function

Anzeige
AW: Excel Zellwerte in andere Excel Datei kopieren
15.01.2013 07:58:42
Alex
Hallo Franz!
Danke für den Code!
Hat mir prima geholfen!
Funktionierte auf Anhieb gleich wunderbar!
Ciao Alex

318 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige