Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1680to1684
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

Makro ändern

Makro ändern
15.03.2019 10:48:23
Matthias
Hallo zusammen
Ich kopiere heute ganz einfach einen Bereich einer Lasche in eine andere Lasche:
Dim N As Long
'Bereich kopieren
strTmp = Cells(Selection.Row, 34).Resize(Selection.Rows.Count, 45).Copy
'Bereich einfügen
Worksheets("CSV").Activate
N = Cells(Rows.Count, "A").End(xlUp).Row + 1
Cells(N, "A").PasteSpecial Paste:=xlValues
'Cells(1, 1).Select
'Worksheets("Berechnung").Activate
Nun habe ich ein neues Muster Makro erhalten, um es etwas ausführlicher zu machen:
Dim e As Object, rngS As Range
For Each e In Sheets("Berechnung").Range("A2:A" & Sheets("Berechnung").Cells(Rows.Count, 1).End(xlUp).Row)
With Sheets("CSV").Range("A2:A" & Sheets("CSV").Cells(Rows.Count, 1).End(xlUp).Row)
Set rngS = .Find(e.Value)
If Not rngS Is Nothing Then
If Sheets("CSV").Cells(rngS.Row, 9).Value Sheets("Berechnung").Cells(e.Row, 2).Value Then
Sheets("CSV").Cells(rngS.Row, 9).Value = Sheets("Berechnung").Cells(e.Row, 2).Value
End If
Else
Sheets("CSV").Cells(Sheets("CSV").Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Value = e.Value
Sheets("CSV").Cells(Sheets("CSV").Cells(Rows.Count, 1).End(xlUp).Row, 9).Value = Sheets("Berechnung").Cells(e.Row, 2).Value
End If
End With
Next e
MsgBox "Übertrag durchgeführt!", vbInformation, "Meldung"
Müsste es nun aber noch etwas anpassen:
1. Statt RangeA2:A, die aktuelle Selektion siehe 1. Makro (strTmp = Cells(Selection.Row, 34).Resize(Selection.Rows.Count, 45).Copy)
2. .Find(e.Value). Wert nur in der Spalte A suchen
3. Statt Row 9 / Row 2 kopieren, einfach die ganze Selektion kopieren.
Wäre grossartig wenn mir das jemand umschreiben könnte. Herzlichen Dank!

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Tipps und Google hilft
15.03.2019 11:28:49
Luisa
Hallo,
1. Es gibt einen Button (Code "pre") mit dem du Code schön einfügen kannst
2. Durch ein paar einrückungen, wäre der Code viel leichter verständlich
Beispiel:

If Sheets("CSV").Cells(rngS.Row, 9).Value  Sheets("Berechnung").Cells(e.Row, 2).Value Then
Sheets("CSV").Cells(rngS.Row, 9).Value = Sheets("Berechnung").Cells(e.Row, 2).Value
End If
Else
Sheets("CSV").Cells(Sheets("CSV").Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Value = e.Value  _
Sheets("CSV").Cells(Sheets("CSV").Cells(Rows.Count, 1).End(xlUp).Row, 9).Value =
Sheets("Berechnung").Cells(e.Row, 2).Value
End If
3. Deine Fragen sind relativ leicht mit Google zu lösen. Schaue zum Beispiel mal nach Selection.Copy bzw. Selection.Past Oder Google mal nach "Wert in einer Spalte finden"
Wenn das nichts hilft, gerne nochmal melden :)
LG Luisa
Anzeige
AW: Tipps und Google hilft
15.03.2019 12:17:18
Matthias
Liebe Luisa
Vielleicht für jemanden der VBA richtig versteht. Ich stehe bei dem .Find(e.Value) vor einem Rätsel das ich nicht "umformulieren" kann. Das mit der Selektion würde ich eher hinkriegen.
Hier also noch übersichtlicher...
Ich kopiere heute ganz einfach einen Bereich einer Lasche in eine andere Lasche:
Dim N As Long
'Bereich kopieren
strTmp = Cells(Selection.Row, 34).Resize(Selection.Rows.Count, 45).Copy
'Bereich einfügen
Worksheets("CSV").Activate
N = Cells(Rows.Count, "A").End(xlUp).Row + 1
Cells(N, "A").PasteSpecial Paste:=xlValues
'Cells(1, 1).Select
'Worksheets("Berechnung").Activate
Nun habe ich ein neues Muster Makro erhalten, um es etwas ausführlicher zu machen:

For Each e In Sheets("Berechnung").Range("A2:A" & Sheets("Berechnung").Cells(Rows.Count, 1).End( _
xlUp).Row)
With Sheets("CSV").Range("A2:A" & Sheets("CSV").Cells(Rows.Count, 1).End(xlUp).Row)
Set rngS = .Find(e.Value)
If Not rngS Is Nothing Then
If Sheets("CSV").Cells(rngS.Row, 9).Value  Sheets("Berechnung").Cells(e.Row,  _
2).Value Then
Sheets("CSV").Cells(rngS.Row, 9).Value = Sheets("Berechnung").Cells(e.Row,  _
2).Value
End If
Else
Sheets("CSV").Cells(Sheets("CSV").Cells(Rows.Count, 1).End(xlUp).Row + 1, 1). _
Value = e.Value
Sheets("CSV").Cells(Sheets("CSV").Cells(Rows.Count, 1).End(xlUp).Row, 9).Value =  _
Sheets("Berechnung").Cells(e.Row, 2).Value
End If
End With
Next e
MsgBox "Übertrag durchgeführt!", vbInformation, "Meldung"
Müsste es nun aber noch etwas anpassen:
1. Statt RangeA2:A, die aktuelle Selektion siehe 1. Makro (strTmp = Cells(Selection.Row, 34).Resize(Selection.Rows.Count, 45).Copy)
2. .Find(e.Value). Wert nur in der Spalte A suchen
3. Statt Row 9 / Row 2 kopieren, einfach die ganze Selektion kopieren.
Anzeige
AW: Tipps und Google hilft
16.03.2019 11:20:14
Matthias
erledigt

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige