Office: Datenaufnahme per VBA kopieren und sichern

Hallo Zusammen,

habe folgende Problematik:

im ersten Arbeitsblatt "Aufnahme" habe ich bereits mein gesammelten Daten. Diese Daten sollen ab A2:M2 (Liste kann beliebig lang sein), je nach Aufnahme unterschiedlich lang, kopiert werden ins zweite Arbeitsblatt "Historie". Dabei soll erkannt werden, wie lang die Historie bereits ist, um an die nächste freie Zelle in Spalte A mit der nächsten kopierten Aufnahme anzuknüpfen. Dann sollen anhand der Aufnahmedati der neueste Aufnahmeblock oben stehen (vielleicht per Sortierung)
Zuletzt der Sprung wieder zurück in das Arbeitsblatt Aufnahme.

Diese Befüllung soll per CommandButton inkls. VBA erfolgen.

Habt Ihr eine gute Idee?

bisheriger code war:

Sub daten_kopieren2()


Range("a2:m2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Zwischenspeicher").Visible = True
Sheets("Zwischenspeicher").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("N12").Select

Dim i, j As Integer

For i = 2 To 600
For j = 1 To 13
If Cells(i, j) "" Then
Cells(i, j).Copy
ThisWorkbook.Sheets("Historie").Activate
Cells(i, j).Insert
ThisWorkbook.Sheets("Aufnahme").Activate
End If
Next j
Next i
Application.CutCopyMode = False


Range("N22").Select
Sheets("Historie").Select

Range("N2").Select


Sheets("Aufnahme").Select
Range("N4").Select

Sheets("Historie").Select

Range("N2").Select
Sheets("Aufnahme").Select
Range("N5").Select


Sheets("Zwischenspeicher").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Aufnahme").Select
Range("N8").Select


End Sub


allerdings kopiert er hier vorher noch in einen Zwischenspeicher...

das möchte ich ebenfalls umgehen...

LG Jan

:)

 

Moin Jan,

hatte gerade Lust.
Bis hierhin hab Ich Dir schonmal was.
Den Button oder weiterführende Änderungen liegen nun bei Dir.

Code:

 

Moin,

@marco: Lerne immer gerne mal dazu: warum benutzt Du für die Variablenzuweisung LET?

 

Moin Regina,

weil es schön macht *angel

 

*grins *grins *grins

 

Moin,

nur der Vollständigkeit halber, der ursprungspost von Gestern: https://www.ms-office-forum.net/foru...d.php?t=362454
ist auch noch offen.

Viele Grüße
derHöpp

 

\@derHöpp:
Nicht gesehen, Danke.

 

Perfekte Lösung!!!

Super, Vielen Dank.

Schnell und genauso, wie ich es mir vorgestellt habe.

Eine Frage noch, funktioniert der Code, egal wie viele Spalten ich habe?

Habe nämlich ähnliche Dateien, in die ich den Code implementieren möchte.

LG und herzlichen Dank

Jan

 

gerne.

In Deinem Fall verwenden wir die Eigenschaft .UsedRange.
Ein Auszug aus der Onlinehilfe:

Bedingt, lässt sich Deine Frage mit Ja beantworten.

Was sagt uns das?
Just Do it !
*wink.gif*

 

wie cool :-)!

eine letzte Frage noch zum Thema, dann setze ich auf erledigt....

Wenn ich die Spalten, die kopiert werden sollen, eingrenzen würde wollen, müsste ich dann die offsets verändern?

LG Jan

 

Du müsstest vorher ein geeignetes Range-Object erzeugen und diese Zeile verändern:

Code:

 

Hi, vielen Dank für die schnelle Antwort.

Nun stehe ich aber etwas auf dem Schlauch, glaube ich....

Möchte praktisch den kopierten Bereich von Spalte A bis Spalte F haben, aber die Zeilen sollen doch noch variabel sein. wäre das hier richtig?

Dim wkb As Workbook
Dim wksHis As Worksheet, wksAuf As Worksheet
Dim arr() As rng.object (so hier?)
Dim lngLastRow As Long
'
On Error GoTo err
'
Call TurnOffFunctionality
'
Set wkb = ThisWorkbook
Set wksHis = wkb.Worksheets(m_sHistorie)
Set wksAuf = wkb.Worksheets(m_sAufnahme)
Set rng.object = range(columns (1), columns(6)) (so hier?)
'
Let arr = (wksAuf.UsedRange.Offset(1, 0)) --> rng.object (so hier?)
'
With wksHis
Let lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
Let .Cells(lngLastRow, 1).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End With
'
err:
If err.Number 0 Then
MsgBox err.Number & vbCrLf & err.Description
End If
'
Call TurnOnFunctionality
'
Erase arr
Set wksHis = wkb.Worksheets(m_sHistorie)
Set wksAuf = wkb.Worksheets(m_sAufnahme)
Set wkb = ThisWorkbook
End Sub

Public Sub TurnOffFunctionality()
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.ScreenUpdating = False
End Sub
Public Sub TurnOnFunctionality()
Application.Calculation = xlCalculationAutomatic
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

 

Naja fast *wink.gif*

Versuch mal folgendes:
Code:

 

Hi, vielen Dank.

Da war ich ja noch meilenweit von weg :-)

Set rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 6).End(xlUp)) 'Bereich: A1 bis F?

die Daten fangen ab A2 bis F2 an.

wäre das dann

Set rng = .Range(.Cells(1, 2), .Cells(.Rows.Count, 6).End(xlUp)) 'Bereich: A2 bis F?

 

Ne, da wir das hier dann mit offset regeln

Code:

Hinweis:
.Cells(< diese Stelle Zeile >, < diese Stelle Spalte >)