01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42 |
|
Sub Makro3()
Dim iZeile As Long, WShQ As Worksheet, rBer As Range
' Daten exportieren in Basis
Set WShQ = Workbooks("Mappe1").Sheets("Tabelle1") ' Quellblatt angeben
With Workbooks("Resultate.xlsm").Sheets("Tabelle1") ' Zielblatt angeben
iZeile = .Cells(Rows.Count, "A").End(xlUp).Row + 1 ' Erste freie Zeile
Set rBer = WShQ.Range("A13:B20") ' Quellbereich angeben
.Cells(iZeile, "A").Resize(rBer.Rows.Count, rBer.Columns.Count).Value = rBer.Value
Set rBer = WShQ.Range("C13:C20") ' Quellbereich angeben
.Cells(iZeile, "E").Resize(rBer.Rows.Count, rBer.Columns.Count).Value = rBer.Value
End With
End Sub
Sub Makro33()
Dim iZeile As Long, WShQ As Worksheet, WKb As Workbook
Dim rBer As Range
' Daten exportieren in Basis
With Workbooks("Resultate.xlsm").Sheets("Tabelle1") ' Zielblatt angeben
For Each WKb In Workbooks
If WKb.Name <> .Parent.Name Then
Set WShQ = WKb.Sheets(1) ' Quellblatt angeben
iZeile = .Cells(Rows.Count, "A").End(xlUp).Row + 1 ' Erste freie Zeile
Set rBer = WShQ.Range("A13:B20") ' Quellbereich angeben
.Cells(iZeile, "A").Resize(rBer.Rows.Count, rBer.Columns.Count).Value = rBer.Value
Set rBer = WShQ.Range("C13:C20") ' Quellbereich angeben
.Cells(iZeile, "E").Resize(rBer.Rows.Count, rBer.Columns.Count).Value = rBer.Value
End If
Next WKb
End With
End Sub
|