Excell-Makro: Wie kann ich Zeilen kopieren wenn

Computer: Software & Programmierung Visual Basic
#1

Hi Leute ich hab ein Problem,

folgende 4 Excellisten habe ich:
1.) C:\kaufen1.xls
2.) C:\kaufen2.xls
3.) C:\kaufen3.xls
4.) C:\statistik.xls (da rein sollen Daten (ganze Zeilen kopiert werden) falls die 2 Werte übereinstimmen)

3 gleiche Listen mit unterschiedlichen Firmen (kaufen1, kaufen2, kaufen 3)

Gibt es ein Makro, das zuerst die Excellisteiste C:\kaufen1.xls fortlaufend durchsucht und wenn darin Zelle $E11=„GW“ (Bearbeiter) ist und Zelle $G11=„nein“ (erledigt) zutrifft mir dann die ganze Zeile fortlaufend in Liste 4.) C:\Statistik.xls hineinkopiert

Bearbeiter (ZELLE=E11) und erledigt (ZELLE=G11) muss gleich sein dann soll ers fortlaufend aus allen Listen, zuerst von Liste kaufen1, dann anschließend Liste kaufen2 und zum Schluss Liste kaufen3 heauskopieren was zutrifft.

Möchte das es mit Makro gleich angezeigt wird - kein Auto-Filter bitte is mir zu lang zum zählen.

Wäre super wenn mir jemand bei der schwierigen Aufgabe helfen kann.
Bin für jede Hilfe dankbar!

Zusammengefasst:
Wenn ZELLE E11=„GW“ und G11=„nein“ in „C:\kaufen1.xls“ übereinstimmen dann soll es die ganze Zeile nach „C:\Statistik.xls“-> Tabellenblatt GW kopieren. Nachdem er das mit „C:\kaufen1.xls“ gemacht soll er es dann mit „C:\kaufen2.xls“ und dann noch mit „C:\kaufen3.xls“ machen.

Habe Laufzeitfehler:1004 bei Zeilen Code:
Workbooks.Open FileName:=Dirs & „“ & FileName

Wie löse ich den Fehler?

Der Ansatz:

'Wenn ZELLE E11=„GW“ und G11=„nein“

Sub DatenHolen()
Dim FilesMax As Long
Dim EintragMax As Long
Dim i As Integer
Dim FileName As String
Dim Dirs As String
Dim Tabname As String
Dim Bed1 As String, Bed2 As String

FilesMax = ThisWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
EintragMax = ThisWorkbook.Sheets(„statistik“).Cells(Rows.Count, 1).End(xlUp).Row
Dirs = ThisWorkbook.Path
For i = 1 To FilesMax
FileName = ThisWorkbook.Sheets(„statistik“).Cells(i, 1).Value
Tabname = ThisWorkbook.Sheets(„statistik“).Cells(i, 2).Value
Workbooks.Open FileName:=Dirs & „“ & FileName

Bed1 = ActiveWorkbook.Sheets(Tabname).Cells(11, 5).Value
Bed2 = ActiveWorkbook.Sheets(Tabname).Cells(11, 7).Value

If Bed1 = „GW“ And UCase(Bed2 = „NEIN“) Then
Rows(11).Copy
ThisWorkbook.Sheets(„Auswertung“).Range(„A“ & EintragMax + 1).PasteSpecial xlValues
End If
ActiveWorkbook().Close
Next
End Sub

#2

Hallo katuba,

Wenn ZELLE E11=„GW“ und G11=„nein“ in „C:\kaufen1.xls“
übereinstimmen dann soll es die ganze Zeile nach
„C:\Statistik.xls“-> Tabellenblatt GW kopieren. Nachdem er das
mit „C:\kaufen1.xls“ gemacht soll er es dann mit
„C:\kaufen2.xls“ und dann noch mit „C:\kaufen3.xls“ machen.

Habe Laufzeitfehler:1004 bei Zeilen Code:
Workbooks.Open FileName:=Dirs & „“ & FileName

k.A. was in Dirs und FileName steht.

Probiers mal so (ungetestet):

Sub DatenHolen()
Dim Quelle, Q As Integer, ZeiS As Long
Const Pfad As String = "C:\"
Quelle = Array("kaufen1", "kaufen2", "kaufen3")
ZeiS = ThisWorkbook.Worksheets("statistik").Cells(Rows.Count, 5).End(xlUp).Row
For Q = 0 To UBound(Quelle)
 Workbooks.Open Pfad & "\" & Quelle(Q) & ".xls"
 With Worksheets(1)
 If UCase(.Range("E11")) = "GW" And UCase(.Range("G11")) = "NEIN" Then
 ZeiS = ZeiS + 1
 .Rows(11).Copy Destination:=Workbooks("statistik").Worksheets("GW").Cells(ZeiS, 1)
 End If
 End With
 ActiveWorkbook.Close savechanges:=False
Next Q
End Sub

Gruß
Reinhard

#3

Hallo Reinhard,

danke für deine schnelle Antwort. Aber irgendwas passt es noch nicht. Habe alles mal auf „E:“ angelegt und nicht auf „C:“.
Hab deine Zeilen entsprechend umgeändert, wenn ich Makro ausführe ist folgende Zeile mit dem Code

---->„ZeiS = ThisWorkbook.Worksheets(„statistik“).Cells(Rows.Count, 5).End(xlUp).Row“

#4

nicht. Habe alles mal auf „E:“ angelegt und nicht auf „C:“.
Hab deine Zeilen entsprechend umgeändert, wenn ich Makro
ausführe ist folgende Zeile mit dem Code

---->"ZeiS =
ThisWorkbook.Worksheets(„statistik“).Cells(Rows.Count,
5).End(xlUp).Row"Sub DatenHolen()

Dim Quelle, Q As Integer, ZeiS As Long
Const Pfad As String = „E:“
Quelle = Array(„kaufen1“, „kaufen2“, „kaufen3“)
ZeiS = Workbooks(„statistik.xls“).Worksheets(„GW“).Cells(Rows.Count, 5).End(xlUp).Row
For Q = 0 To UBound(Quelle)
Workbooks.Open Pfad & „“ & Quelle(Q) & „.xls“
With Worksheets(1)
If UCase(.Range(„E11“)) = „GW“ And UCase(.Range(„G11“)) = „NEIN“ Then
ZeiS = ZeiS + 1
.Rows(11).Copy Destination:=Workbooks(„statistik.xls“).Worksheets(„GW“).Cells(ZeiS, 1)
End If
End With
ActiveWorkbook.Close savechanges:=False
Next Q
End Sub

Gruß
Reinhard

#5

Hi Reinhard!

Danke erstmal, bin wieder einen Schritt weiter. Also das kopieren geht, aber er kopiert von jeder Tabelle nur die erste Zeile (ZEILE 11) jeweils, falls die Bedingungen zutreffen.

1.) Was muss ich am Code ändern damit er „Alle Zeilen kopiert“ wo er von eine Liste findet?

2.) Kann ich es so einstellen dass er die Zieldaten eine Spalte versetzt reinkopiert ab Zeile 11?

3.) kann ich statt der Bedingung (=„nein“) auch eingeben sobald ein „Datum“ in der Zelle steht?

Gruss Markus

Der bisherige Code:

'Wenn ZELLE E11=„GW“ und G11=„nein“

Sub DatenHolen()
Dim Quelle, Q As Integer, ZeiS As Long
Const Pfad As String = „E:“
Quelle = Array(„kaufen1“, „kaufen2“, „kaufen3“)
ZeiS = Workbooks(„statistik.xlsm“).Worksheets(„GW“).Cells(Rows.Count, 5).End(xlUp).Row
For Q = 0 To UBound(Quelle)
Workbooks.Open Pfad & „“ & Quelle(Q) & „.xlsx“
With Worksheets(1)
If UCase(.Range(„E11“)) = „GW“ And UCase(.Range(„G11“)) = „NEIN“ Then
ZeiS = ZeiS + 1
.Rows(11).Copy Destination:=Workbooks(„statistik.xlsm“).Worksheets(„GW“).Cells(ZeiS, 1)
End If
End With
ActiveWorkbook.Close savechanges:=False
Next Q
End Sub

#6

Hi Reinhard,

er kopiert nur Zeile 11 von jeder Liste rein!
Kann es sein dass ich ne Schleife reinmachen muss mit ner Loopfunktion oder so, damit er auch die anderen Zeilen nach unten kopiert?

Gruss Markus

'Wenn ZELLE E11=„GW“ und G11=„nein“

Sub DatenHolen()
Dim Quelle, Q As Integer, ZeiS As Long
Const Pfad As String = „E:“
Quelle = Array(„kaufen1“, „kaufen2“, „kaufen3“)
ZeiS = Workbooks(„statistik.xlsm“).Worksheets(„GW“).Cells(Rows.Count, 5).End(xlUp).Row
For Q = 0 To UBound(Quelle)
Workbooks.Open Pfad & „“ & Quelle(Q) & „.xlsx“
With Worksheets(1)
If UCase(.Range(„E11“)) = „GW“ And UCase(.Range(„G11“)) = „NEIN“ Then
ZeiS = ZeiS + 1
.Rows(11).Copy Destination:=Workbooks(„statistik.xlsm“).Worksheets(„GW“).Cells(ZeiS, 1)
End If
End With
ActiveWorkbook.Close savechanges:=False
Next Q
End Sub