ich habe eine Arbeitsmappe mit mehreren Tabellen die in eine Tabelle zusammengefasst werden sollen.
Die Werte sollen in der Tabelle "Alle" eingefügt werden!
In der Tabelle "Alle" Spalte F sind E-Mail-Adressen die sollen dann über Outlook eine Einladung mit den jeweilugen
Thema bekommen Spalte B und eine Link über Spalte G
Das sind meine ersten ansätze:
Sub kopieren()
Dim intBlatt As Long
Dim intBlatt1 As Long
Dim lngLetzteZeile As Long
Dim lngZielZeile As Long
Set wks1 = Worksheets("Windows 10 Funktionen")
Set wks2 = Worksheets("MS Excel Modul1")
lngLetzteZeile = Sheets("Alle").Cells(Rows.Count, 3).End(xlUp).Row
Sheets("Alle").Range("A2:G" & lngLetzteZeile).ClearContents
lngZielZeile = 2
For intBlatt = 2 To ActiveWorkbook.Worksheets.Count
'Windows 10 Funktionen
Sheets("Alle").Cells(lngZielZeile, 1).Value = Sheets("Windows 10 Funktionen").Cells(3, 2).Value
Sheets("Alle").Cells(lngZielZeile, 2).Value = Sheets("Windows 10 Funktionen").Cells(4, 2).Value
Sheets("Alle").Cells(lngZielZeile, 3).Value = Sheets("Windows 10 Funktionen").Cells(5, 2).Value
Sheets("Alle").Cells(lngZielZeile, 4).Value = Sheets("Windows 10 Funktionen").Cells(lngZielZeile + 6, 1).Value
Sheets("Alle").Cells(lngZielZeile, 5).Value = Sheets("Windows 10 Funktionen").Cells(lngZielZeile + 6, 2).Value
Sheets("Alle").Cells(lngZielZeile, 6).Value = Sheets("Windows 10 Funktionen").Cells(lngZielZeile + 6, 3).Value
'MS Excel Modul1
Sheets("Alle").Cells(lngZielZeile, 1).Value = Sheets("MS Excel Modul1").Cells(3, 2).Value
Sheets("Alle").Cells(lngZielZeile, 2).Value = Sheets("MS Excel Modul1").Cells(4, 2).Value
Sheets("Alle").Cells(lngZielZeile, 3).Value = Sheets("MS Excel Modul1").Cells(5, 2).Value
Sheets("Alle").Cells(lngZielZeile, 4).Value = Sheets("MS Excel Modul1").Cells(lngZielZeile + 6, 1).Value
Sheets("Alle").Cells(lngZielZeile, 5).Value = Sheets("MS Excel Modul1").Cells(lngZielZeile + 6, 2).Value
Sheets("Alle").Cells(lngZielZeile, 6).Value = Sheets("MS Excel Modul1").Cells(lngZielZeile + 6, 3).Value
lngZielZeile = lngZielZeile + 1
Next
End Sub
Sub Outlook_Termin()
'Outlook Bibliothek aktivieren
'Variablen dimensionieren
Dim oApp As New Outlook.Application
Dim oTermin As Outlook.AppointmentItem
Set oTermin = oApp.CreateItem(olAPPointmentItem)
'Termin erstellen
Dim i As Integer
letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
i = 2
For i = 1 To letztezeile
With oTermin
.Display
.Subject = Tabelle1.Cells(i, 2).Value
.RequiredAttendees = Tabelle1.Cells(i, 1).Value
' .To = Tabelle1.Cells(i, 3).Value
'.OptionalAttendees
.Start = -Value
.Duration = 60
.Body = "Einladung," & Chr(10) & "xxxxxxxx " & Tabelle1.Cells(i, 2).Value
End With
Next i
'Variablen leeren
Set oApp = Nothing
Set oTermin = Nothing
End Sub
anbei eine Tabelle: https://www.herber.de/bbs/user/151475.xlsx
Vielen Dank im Vorraus!