Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 21:51:33
Idee für Grafik
26.04.2024 21:29:07
PQ zufällige Reihenfolge
26.04.2024 17:18:47
Große Datenmenge in komplexes Diagramm verpacken
26.04.2024 16:22:47
Aktualisierung Verknüpfung bei geschlossener Quelldatei
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1892to1896
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1892to1896
1892to1896
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Daten speichern

Daten speichern
08.08.2022 10:26:30
Christina
Hallo,
ich habe folgendes Problem ich möchte, dass mein Makro automatisch in die nächste untere freie Zeile die Werte speichert.
Derzeit, überschreibt er einfach die Werte in der ausgewählten Zeile.
Ich hoffe es kann mir jemand den Code umschreiben, sodass er automatisch in die nächste untere Zeile speichert.
Beispiel.
12 15 xxx 17
18 23 xxx 27
...
...
usw.
Falls ich es unverständlich gefragt habe , bitte einfach sagen.
Danke!!

Sub Macro1()
' Macro1 Macro
Range("B2").Select
Selection.Copy
Windows("Tabelle_finish.xlsx").Activate
ActiveSheet.Paste
Windows("x1.xlsx").Activate
Application.CutCopyMode = False
Range("B5").Select
Selection.Copy
Windows("Tabelle_finish.xlsx").Activate
Range("B3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Windows("x1.xlsx").Activate
ActiveWindow.SmallScroll Down:=90
Range("B109").Select
Selection.Copy
Windows("Tabelle_finish.xlsx").Activate
Range("C3").Select
ActiveSheet.Paste
Windows("x1.xlsx").Activate
Application.CutCopyMode = False
Range("B110").Select
Selection.Copy
Windows("Tabelle_finish.xlsx").Activate
Range("D3").Select
ActiveSheet.Paste
Range("D4").Select
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: Daten speichern
08.08.2022 10:46:00
ChrisL
Hi Christina
Was, wohin kopiert werden muss, kann man nur erraten. (Beispieldatei würde helfen)
Hier mal ein Ansatz:

Sub tt()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim LetzteZeile As Long
Set ws1 = Workbooks("x1.xlsx").Worksheets("Tabelle1")
Set ws2 = Workbooks("Tabelle_finish.xlsx").Worksheets("Tabelle1")
LetzteZeile = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1
ws1.Range("B2").Copy ws2.Cells(LetzteZeile, 1)
ws1.Range("B5").Copy ws2.Cells(LetzteZeile, 2)
ws1.Range("B109").Copy ws2.Cells(LetzteZeile, 3)
ws1.Range("B110").Copy ws2.Cells(LetzteZeile, 4)
End Sub
(B2 in Spalte A, B5 in Spalte B, B109 in Spalte C, B110 in Spalte D)
cu
Chris
Anzeige
AW: Daten speichern
08.08.2022 12:15:29
Christina
Hallo Chris,
danke schon Mal für deinen Ansatz!
Ich lade dir mal Beispieldaten hoch,1) Zieldatei, wo es eben untereinander gespeichert werden soll und 2) die Ausgangsdatei aus der die Daten kommen ( es sind natürlich, dann sehr viele Files aber die Daten stehen wie im Beispiel immer an der selben Stelle, man muss bisschen scrollen aber der Screenshot von vorhing, zeigt ja wo die Daten tatsächlich stehen).
https://www.herber.de/bbs/user/154554.xlsm
https://www.herber.de/bbs/user/154555.xlsx
LG
Christina
Anzeige
AW: Daten speichern
08.08.2022 12:40:37
ChrisL
Hi Christina
Wie es scheint, habe ich zufälligerweise richtig geraten. Hast du mein Makro ausprobiert?
Die Namen der Mappen/Tabellenblätter müssen individuell angepasst werden z.B.

Sub tt()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim LetzteZeile As Long
Set ws1 = ThisWorkbook.Worksheets(1)
Set ws2 = Workbooks("154555.xlsx").Worksheets("Sheet1")
LetzteZeile = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1
ws1.Range("B2").Copy ws2.Cells(LetzteZeile, 1)
ws1.Range("B5").Copy ws2.Cells(LetzteZeile, 2)
ws1.Range("B109").Copy ws2.Cells(LetzteZeile, 3)
ws1.Range("B110").Copy ws2.Cells(LetzteZeile, 4)
End Sub
cu
Chris
Anzeige
AW: Daten speichern
08.08.2022 13:21:11
Christina
Super Chris , hat funktioniert ! DANKE :)
Hab jetzt nur eine Frage und zwar, wie mache ich das, dass er es für jedes file den neuen Namen automatisch nimmt?
Also statt x1 , das file mit x2 und sheet1.
Diesen Code habe ich , dass er die ganzen Ordner durcharbeitet, aber jetzt ist er ja immer an das eine File gebunden oder?

Sub LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Do While xFileName  ""
With Workbooks.Open(xFdItem & xFileName)
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim LetzteZeile As Long
Set ws1 = Workbooks("x1.xlsx").Worksheets("Sheet1")
Set ws2 = Workbooks("Tabelle_finish.xlsx").Worksheets("Sheet2")
LetzteZeile = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1
ws1.Range("B2").Copy ws2.Cells(LetzteZeile, 1)
ws1.Range("B5").Copy ws2.Cells(LetzteZeile, 2)
ws1.Range("B109").Copy ws2.Cells(LetzteZeile, 3)
ws1.Range("B110").Copy ws2.Cells(LetzteZeile, 4)
End With
xFileName = Dir
Loop
End If
End Sub

Anzeige
AW: Daten speichern
08.08.2022 14:00:23
Rudi
Hallo,
teste mal:

Sub LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim LetzteZeile As Long
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Set ws2 = Workbooks("Tabelle_finish.xlsx").Worksheets("Sheet2")
Do While xFileName  ""
Set ws1 = Workbooks.Open(xFdItem & xFileName).Sheets("Sheet1")
LetzteZeile = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1
ws1.Range("B2").Copy ws2.Cells(LetzteZeile, 1)
ws1.Range("B5").Copy ws2.Cells(LetzteZeile, 2)
ws1.Range("B109").Copy ws2.Cells(LetzteZeile, 3)
ws1.Range("B110").Copy ws2.Cells(LetzteZeile, 4)
ws1.Parent.Close False
xFileName = Dir
Loop
End If
End Sub
Gruß
Rudi
Anzeige
AW: Daten speichern
08.08.2022 14:27:25
Christina
Hallo Rudi,
nein klappt leider nicht, bekomme dann einen Runtime error 9, eventuell müssen vielleicht die sheets 1 auch dynamisch werden, da die teilweise unterschiedliche Namen haben in den files als sheet 1.
AW: Daten speichern
08.08.2022 14:34:57
Rudi
wenn es immer das erste ist:
Set ws1 = Workbooks.Open(xFdItem & xFileName).Sheets(1)
AW: Daten speichern
08.08.2022 14:36:26
Christina
Super Rudi es funktioniert!! Vielen DANK! :)

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige