Codeerweiterung
18.01.2005 06:34:39
Thomas
Luschi und Andre´... haben mir letzte Woche einen Code geschrieben, s.u.
--------------------------------------------------------------
Sub CopyM400()
Dim wb As Workbook, _
ws1 As Worksheet, ws2 As Worksheet, _
rg1 As Range, rg2 As Range, _
i1 As Integer, i2 As Integer, i3 As Integer, _
s1 As String, s2 As String
Application.ScreenUpdating = False
Set wb = ThisWorkbook
Set ws1 = wb.Worksheets("Lohndaten")
Set ws2 = wb.Worksheets("Buch")
Set rg1 = ws1.Range("M10:M400")
ws2.Rows("10:400").ClearContents
i1 = 10
For Each rg2 In rg1
If rg2.Value = "400" Then
ws1.Select
i2 = rg2.Row
s1 = "" & i2 & ":" & i2
ws1.Rows(s1).Select
Selection.Copy
s2 = "" & i1 & ":" & i1
ws2.Select
ws2.Rows(s2).Select
ws2.Paste
i1 = i1 + 1
End If
Next rg2
Application.CutCopyMode = False
ws2.Range("A" & i1).Select
Set rg1 = Nothing
Set rg2 = Nothing
Set ws1 = Nothing
Set ws2 = Nothing
Set wb = Nothing
Application.ScreenUpdating = False
End Sub
Nun habe ich Gedacht, ich könnte diesen Code selber erweitern, jedoch gestaltet sich dies für mich als absoluten VBA Neuling schwieriger als gedacht.
Der Code sollte wenn sich jemand meiner annimmt so umgeschrieben werden, dass auch Blatt Lohndaten_2 mit einbezogen wird.
anbei die Datei:
https://www.herber.de/bbs/user/16266.xls
Es würde mich sehr Freuen, hierfür von euch Unterstützung zu bekommen
Gruß Thomas