Makroerstellung

Question

Hallo zusammen,

ich habe keinerlei Erfahrungen mit dem Erstellen von Excel-Makros. Darum bitte ich euch mir zu helfen. Habe folgendes Problem:

Habe eine Datei1 (Haupt) in die ich aus Datei2, Datei3, Datei4, ….. Werte importieren will.
Die zu importierenden Werte stehen in den Dateien (Datei2, Datei3, …..) immer an der gleichen Stelle.

Beispiel:
Aus Datei2 sind die Werte „b5+d5+f5+h5+j5+b10+d10+f10+h10+j10“ auszulesen.
Ebenso die Werte „b6+d6+f6+h6+j6+b11+d11+f11+h11+j11“.
Das gleiche soll mit den Werten „c5+e5+g5+i5+k5+c10+e10+g10+i10+k10“ + „c6+e6+g6+i6+k6+c11+e11+g11+i11+k11“ passieren (alle horizontal).

Einfügen muss ich sie aber in Datei1 vertikal.
D.h. „b5(Datei2) = c5(Datei1); d5(Datei2) = c6(Datei1) …. j10(Datei2) = c14(Datei1)“. Insgesamt gibt es dann 4 Spalten a 10 Werte.

Habe mir ein Makro erstellt indem ich immer 5 dieser Werte (c5+e5+g5+i5+k5=Datei2) markiere und dann in Datei1 wieder einfüge. Das erste Mal funktioniert das auch prima, nur beim 2. Mal werden die Werte ja wieder überschrieben und das sollte nicht sein. Diese sollten in einer anderen Zelle einzufügen sein.
Gibt es hier eine einfache, auch für mich verständliche, nachvollziehbare Lösung?

Im Voraus schon mal Danke.

Klaus

Answer 1

Hallo,

gundsätzlich gibt es dafür eine Lösung, aber zum einen solltest du uns das Makro mal zur Verfügung stellen, da wir so den Aufbau des Makros nur raten können. Zum zweiten solltest du uns auch sagen wo die Daten dann hingeschrieben werden sollen

Gruß

Helmut

Answer 2

hi all :-)

ein beispiel fuer 2 bereiche

gruss nighty

Sub DateienLesen()
Call EventsOff
Dim DateiName As String
Dim RbereichA As Range
Dim RbereichB As Range
DateiName = Dir("C:\Temp\" & "*.xls")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:="C:\Temp\" & DateiName
With Workbooks(DateiName).Worksheets(1)
Set RbereichA = Application.Union(.Range("A1"), .Range("C1"), .Range("E1"))
Set RbereichB = Application.Union(.Range("A2"), .Range("C2"), .Range("E2"))
Rbereich.Copy
ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial xlPasteValues, Transpose:=True
ThisWorkbook.Worksheets(1).Range("D" & ThisWorkbook.Worksheets(1).Cells(Rows.Count, 4).End(xlUp).Row + 1).PasteSpecial xlPasteValues, Transpose:=True
End With
Workbooks(DateiName).Close SaveChanges:=True
End If
DateiName = Dir
Loop
Call EventsOn
End Sub

Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub

Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Answer 3

hi all :-)

korrigiert

gruss nighty

Sub DateienLesen()
Call EventsOff
Dim DateiName As String
Dim RbereichA As Range
Dim RbereichB As Range
DateiName = Dir("C:\Temp\" & "*.xls")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:="C:\Temp\" & DateiName
With Workbooks(DateiName).Worksheets(1)
Set RbereichA = Application.Union(.Range("A1"), .Range("C1"), .Range("E1"))
Set RbereichB = Application.Union(.Range("A2"), .Range("C2"), .Range("E2"))
RbereichA.Copy
ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial xlPasteValues, Transpose:=True
RbereichB.Copy
ThisWorkbook.Worksheets(1).Range("D" & ThisWorkbook.Worksheets(1).Cells(Rows.Count, 4).End(xlUp).Row + 1).PasteSpecial xlPasteValues, Transpose:=True
End With
Workbooks(DateiName).Close SaveChanges:=True
End If
DateiName = Dir
Loop
Call EventsOn
End Sub

Answer 4

Hallo Helmut, hallo Gemeinde,
ihr werde jetzt lachen, aber wie ich schon eingangs sagte habe ich keinerlei Erfahrung mit Makros. Dem entsprechend sieht auch mein erstelltes Makro aus. :-)

Sub Makro1()
'
' Makro1 Makro
' Makro am 26.08.2010 von xxxxx aufgezeichnet
'

'
Range("C5").Select
Windows("Datei2.xls").Activate
Range("B5,D5,F5,H5,J5").Select
Range("J5").Activate
Selection.Copy
Windows("Makro_oeffnen_Dateien.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=True
Windows("Datei2.xls").Activate
Range("B10,D10,F10,H10,J10").Select
Range("J10").Activate
Application.CutCopyMode = False
Selection.Copy
Windows("Makro_oeffnen_Dateien.xls").Activate
Range("C10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=True
Windows("Datei2.xls").Activate
Range("C5,E5,G5,I5,K5").Select
Range("K5").Activate
Application.CutCopyMode = False
Selection.Copy
Windows("Makro_oeffnen_Dateien.xls").Activate
Range("D5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=True
Windows("Datei2.xls").Activate
Range("C10,E10,G10,I10,K10").Select
Range("K10").Activate
Application.CutCopyMode = False
Selection.Copy
Windows("Makro_oeffnen_Dateien.xls").Activate
Range("D10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=True
Windows("Datei2.xls").Activate
Range("B6,D6,F6,H6,J6").Select
Range("J6").Activate
Application.CutCopyMode = False
Selection.Copy
Windows("Makro_oeffnen_Dateien.xls").Activate
Range("E5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=True
Windows("Datei2.xls").Activate
Range("B11,D11,F11,H11,J11").Select
Range("J11").Activate
Application.CutCopyMode = False
Selection.Copy
Windows("Makro_oeffnen_Dateien.xls").Activate
Range("E10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=True
Windows("Datei2.xls").Activate
Range("C6,E6,G6,I6,K6").Select
Range("K6").Activate
Application.CutCopyMode = False
Selection.Copy
Windows("Makro_oeffnen_Dateien.xls").Activate
Range("F5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=True
Windows("Datei2.xls").Activate
Range("C11,E11,G11,I11,K11").Select
Range("K11").Activate
Application.CutCopyMode = False
Selection.Copy
Windows("Makro_oeffnen_Dateien.xls").Activate
Range("F10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=True
Range("C15").Select
Windows("Datei2.xls").Activate
Range("A12").Select
Application.CutCopyMode = False
Windows("Makro_oeffnen_Dateien.xls").Activate
End Sub

Auf jedenfalls bin ich Stolz, dass es wenigstens einmal funktioniert hat :-) *jubel*

Trotzdem vielen Dank.
Gruss Klaus


P.S. ich werde mir mal das Makro von nighty kopieren und ausprobieren.

Answer 5

hallo zusammen,
hat prima funktioniert. bin begeistert!

gruss Klaus