Live-Forum - Die aktuellen Beiträge
Datum
Titel
15.07.2024 16:00:57
15.07.2024 15:41:38
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Markierte Zeile per VBA in andere Mappe kopieren

Markierte Zeile per VBA in andere Mappe kopieren
17.11.2016 18:48:26
Basti
Hi Leute,
ich stehe schon wieder auf dem Schlauch und brauche von den VBA-Helden hier etwas Hilfe.
Im Forum habe ich einen Code gefunden, der die Daten einer markierten Zellen in eine andere, geschlossene Arbeitsmappe schreibt.
Leider kopiert der Code nur den Werte aus der ersten Zelle, der jeweils gewählten Zeile.
Ich würde gerne immer fest definierte Zellen kopieren (z.B A, C, E, F, G)
Ich vermutet, es geht mit einer kleinen Änderung im Code.
Danke für Eure Hilfe.
Gruß
Basti

https://www.herber.de/forum/archiv/1152to1156/1154379_Zeilen_markieren_und_per_VBA_kopieren.html#top
Sub myCopy3()
Dim objXLApp As Excel.Application
Dim objXLABC As Excel.Workbook
Dim objXLWorkbooks As Excel.Workbooks
Dim neuWkb
Dim lngLastRow As Long
Dim mySelection()
Dim myCounter()
Dim i As Long
mySelection = Selection
ReDim myCounter(1 To UBound(mySelection))
For i = LBound(mySelection()) To UBound(mySelection())
myCounter(i) = mySelection(i, 1)
Next
Set objXLApp = New Excel.Application
Set objXLWorkbooks = objXLApp.Workbooks
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set objXLABC = objXLWorkbooks.Open("C:\Users\Steffen\Desktop\Mappe2.xls")
neuWkb = objXLABC.Name
With objXLWorkbooks(neuWkb).Sheets(1)
lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = LBound(mySelection()) To UBound(mySelection())
.Cells(lngLastRow + i, 1).Offset(1, 0) = myCounter(i)
Next
End With
objXLWorkbooks(neuWkb).Close savechanges:=True
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Set objXLApp = Nothing
Set objXLWorkbooks = Nothing
End Sub

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Markierte Zeile per VBA in andere Mappe kopieren
17.11.2016 19:16:09
Bastian
Hey Basti
So ?
Sub myCopy3()
Dim objXLApp As Excel.Application
Dim objXLABC As Excel.Workbook
Dim objXLWorkbooks As Excel.Workbooks
Dim neuWkb
Dim lngLastRow As Long
Dim mySelection()
Dim myCounter()
Dim i As Long
mySelection = Selection
ReDim myCounter(1 To UBound(mySelection, 1), 1 To UBound(mySelection, 2))
For i = LBound(mySelection, 1) To UBound(mySelection, 1)
For r = LBound(mySelection, 2) To UBound(mySelection, 2)
myCounter(i, r) = mySelection(i, r)
Next
Next
Set objXLApp = New Excel.Application
Set objXLWorkbooks = objXLApp.Workbooks
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set objXLABC = objXLWorkbooks.Open("C:\Users\bastian\Desktop\Neu.xlsx")
neuWkb = objXLABC.Name
With objXLWorkbooks(neuWkb).Sheets(1)
lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = LBound(mySelection, 1) To UBound(mySelection, 1)
For r = LBound(mySelection, 2) To UBound(mySelection, 2)
.Cells(lngLastRow + i, r).Offset(1, 0) = myCounter(i, r)
Next
Next
End With
Gruß Basti
Anzeige
AW: Markierte Zeile per VBA in andere Mappe kopieren
17.11.2016 19:38:35
Basti
Hi Basti ;-),
Danke für deine schnelle Antwort, aber noch nicht das was ich benötige!
Jetzt kopiert der Code zwar alles innerhalb der Markierung, aber ich würde gerne, dass immer die gleichen Zellen, die evtl. auch nich aneinander hängen, kopiert werden.

Immer Kopie von (A,C,D,G & J)
Bsp1.: Markierung in Zeile 1, dann Kopie von (A1,C1,D1,G1 & J1),
Bsp2.: Markierung in Zeile 2, dann Kopie von (A2,C2,D2,G2 & J2)usw.

Gruß
Basti II
AW: Markierte Zeile per VBA in andere Mappe kopieren
17.11.2016 20:36:07
Bastian
Dann so ?
Gruß BAsti
ub myCopy3()
Dim objXLApp As Excel.Application
Dim objXLABC As Excel.Workbook
Dim objXLWorkbooks As Excel.Workbooks
Dim neuWkb
Dim lngLastRow As Long
Dim rng As Range
Dim i As Long
Dim rr As Long
Dim zells As Range
rr = Selection.Row
Set rng = Range("A1,C1,D1,G1,J1").Offset(rr - 1)
Set objXLApp = New Excel.Application
Set objXLWorkbooks = objXLApp.Workbooks
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set objXLABC = objXLWorkbooks.Open("C:\Users\bastian\Desktop\Neu.xlsx")
neuWkb = objXLABC.Name
With objXLWorkbooks(neuWkb).Sheets(1)
lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For Each zell In rng
i = i + 1
.Cells(lngLastRow + 1, i).Offset(1, 0) = zell
Next
End With
objXLWorkbooks(neuWkb).Close savechanges:=True
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Set objXLApp = Nothing
Set objXLWorkbooks = Nothing
End Sub

Anzeige
AW: Markierte Zeile per VBA in andere Mappe kopieren
18.11.2016 18:14:46
Basti
Jup, so soll er tun! Danke für deine schnell Hilfe.
Da kommt mir noch eine kleine Idee zur Optimierung, die ich gerne mit unterbringen würde.
Der u.a. Code fügt in eine Tabelle in die ersten drei Spalten 1. forltaufende Nummer 2. UserName 3. aktuelle Datum, ein.
Wie könnte man diesen Teil in den Code einbringen, sodass er die kopierten Daten erst ab Splate D einträgt und Spalte A bis C mit den o.a Werten befüllt?
Danke für die zusätzliche Hilfe.
Gruß
Basti
Sub Nutzerprotokoll()
Dim intNfZ As Integer 'Nächste freie Zeile
intNfZ = ThisWorkbook.Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row + 1
With ActiveSheet
If intNfZ = 2 Then .Cells(intNfZ, 1).Value = 1 Else: .Cells(intNfZ, 1).Value = .Cells( _
intNfZ - 1, 1).Value + 1
.Cells(intNfZ, 2).Value = Application.UserName & " " & Date & " " & Time
'.Cells(intNfZ, 3).Value = Date
'.Cells(intNfZ, 4).Value = Time
End With
End Sub

Anzeige
AW: Markierte Zeile per VBA in andere Mappe kopieren
18.11.2016 18:55:51
Bastian
Soll beim einfügen eine spalte zwischen neuer und alter eintrag sein ?
AW: Markierte Zeile per VBA in andere Mappe kopieren
20.11.2016 18:51:36
Basti
Du meinst doch bestimmt Zeile?! Zwischen dem letzten und dem neuen Eintrag soll keine Spalte oder Zeile frei bleiben.
Spalte A = fortlaufende Nummerierung
Spalte B = UserName
Spalte C = Datum/Uhrzeit
Spalte D u. folgende = Inhalt aus der Quelldatei.
Gruß
Basti
AW: Markierte Zeile per VBA in andere Mappe kopieren
20.11.2016 19:49:46
Bastian
Hey Basti
So
Gruß Basti
Sub myCopy3()
Dim objXLApp As Excel.Application
Dim objXLABC As Excel.Workbook
Dim objXLWorkbooks As Excel.Workbooks
Dim neuWkb
Dim lngLastRow As Long
Dim rng As Range
Dim i As Long
Dim rr As Long
Dim zells As Range
rr = Selection.Row
Set rng = ActiveSheet.Range("A1,C1,D1,G1,J1").Offset(rr - 1)
Set objXLApp = New Excel.Application
Set objXLWorkbooks = objXLApp.Workbooks
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set objXLABC = objXLWorkbooks.Open("C:\Users\bastian\Desktop\Neu.xlsx")
neuWkb = objXLABC.Name
With objXLWorkbooks(neuWkb).Sheets(1)
lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
If lngLastRow = 1 Then
Laufendezahl = 1
Else
Laufendezahl = .Cells(lngLastRow, 1) + 1
End If
.Cells(lngLastRow + 1, 1) = Laufendezahl
.Cells(lngLastRow + 1, 2) = Application.UserName
.Cells(lngLastRow + 1, 3) = Now
i = 3
For Each zell In rng
i = i + 1
.Cells(lngLastRow + 1, i) = zell
Next
End With
objXLWorkbooks(neuWkb).Close savechanges:=True
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Set objXLApp = Nothing
Set objXLWorkbooks = Nothing
End Sub

Anzeige
AW: Markierte Zeile per VBA in andere Mappe kopieren
21.11.2016 15:57:08
Basti
Perfect! Vielen Danke für deine erneute Hilfe und Zeit.
Gruß
Basti

321 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige