Per Makro in einer Excel Namen suchen, range makieren, range kopieren, andere Excel, in Range einfügen

Vorhanden sind 2 Daten. Einmal tagesaktuelle auslesungen und die Zieldatei in die einige Daten müssen.

Moin,

in der Überschrift in Kurzform gehalten, hier nun in der Langform erklärt.

Ich habe eine Datei in der Tagesaktuelle auslesungen von PV Anlagen sind. Da es vorkommen kann das dort weitere PV Anlangen hinzukommen, ist es nicht möglich eine Feste Range mitzugeben, die das kopieren soll.

Plan war nun ein Makro zu schreiben was in die tagesauslesung geht, nach dem PV Anlagennamen sucht (In Spalte A) dann die Werte der einzelnen Wechselrichter kopiert (eine Zeile tiefer und in Spalte B). Die Anzahl der Wechselrichtger (Pro WR eine Zeile) ist somit FEST.

Dass das Makro in EINER Datei sucht und die Zeilen findet funktionierte. Nun wollte ich das um die Dateiöffnung und der dortigen Suche erweitern.

In der Tagesauslesung heißt die Mappe "Sheet1" in der Zieldatei immermal anders in meinem BEispiel nun "Tabelle1".

Das Makro ist bisher so aufgebaut das ich vorab nach und nach die Variablen setze und diese dann per Schleife aufrufen lasse.
Somit müsste auch per Variable die Range in die die Daten in die Zieldatei sollen per Variabler übergeben werden, da sich diese ja ständig ändert.

In meinem BEispiel ist Dettenhofen betroffen. In der Zieldatei sollen die Daten in die Range B4:B14

Die Maximale Zeilenanzahl ist 300 in der Tagesauslesungsdatei in der er Suchen soll.

Nachdem ich nun das Makro um die Öffnung der AUslegunsdatei erweitert habe springt er beim Debuggen nicht mehr soweit um die Zeilen zu Makieren.
Ich verzweifle grad!

Danke für eure Hilfe, sollten noch Fragen sein, dann fragt

Makro:

Sub Filtern()

Dim Parknummer As Integer
Dim Parkname As String
Dim Suchbereich As Integer
Dim WRAnzahl As Byte

 'Excel öffnen  
    Workbooks.Open Filename:= _
        "N:\PFAD\_tagesauslesung_zählerstände.xls" _  
        
'Einsetzen der entsprechenden Daten  
For Parknummer = 1 To 1
 If Parknummer = 1 Then
  Parkname = "Dettenhofen"  
  WRAnzahl = 11
 End If   
   
'Suchen nach Parkname, Auswahl der Daten entsprechend der Anzahl  
For Suchbereich = 1 To 300
 Workbooks("_tagesauslesung_zählerstände").Activate  
 If Cells(Suchbereich, 1) = Parkname Then
   Cells(Suchbereich, 1).Select
   Selection.Offset(1, 1).Select
   Range(Cells(ActiveCell.Row, 2), Cells((ActiveCell.Row + (WRAnzahl - 1)), 2)).Select
 Selection.Copy

Exit For
End If

    Next
 Next
End Sub

Please also mark the comments that contributed to the solution of the article

Content-Key: 188648

Url: https://administrator.de/contentid/188648

Printed on: May 10, 2024 at 21:05 o'clock

2 Comments

Latest comment

Moin,

ok, nach kleinem hin und her, fehler mit "End If" und "Exit For" gefunden. Die hab ich verdreht.
Nun Makiert er.

Dann kann ich nun weiter basteln. Vielleicht hat jemand eine elegantere Lösung, denke aber so bin ich aufm guten Weg.

Moin,

FERTIG :D

Das Script ist nun Variabel erweiterbar, führt die zu öffnende Datei im Hiddenmode aus und schließt sich danach wieder.

Sub Filtern()

Application.ScreenUpdating = False 'Screen off  

'Marko um in der Tagesauslesung nach Parknamen zu suchen um diese zu Kopieren und in die Tabelle einzutragen  

Dim Parknummer As Integer
Dim Parkname As String
Dim Suchbereich As Integer
Dim WRAnzahl As Byte


'Excel Datei öffnen  
    Workbooks.Open Filename:= _
        "N:\PFAD\_tagesauslesung_zählerstände.xls" _  

    'Deklarierung der Entsprechenden Daten  
    For Parknummer = 1 To 3 'Erste Schleife  
     If Parknummer = 1 Then
        Parkname = "Dettenhofen"  
        WRAnzahl = 11
     End If
    If Parknummer = 2 Then
        Parkname = "Oberostendorf"  
        WRAnzahl = 9
     End If
     If Parknummer = 3 Then
        Parkname = "Münster"  
        WRAnzahl = 12
     End If
    
        'Suchlauf nach Parknamen. Kopieren und Einfügen der Daten  
        Workbooks("_tagesauslesung_zählerstände.xls").Activate  
        For Suchbereich = 1 To 300 'Zweite Schleife  
            If Cells(Suchbereich, 1) = Parkname Then
                Cells(Suchbereich, 1).Select
                Selection.Offset(1, 1).Select
                Range(Cells(ActiveCell.Row, 2), Cells((ActiveCell.Row + (WRAnzahl - 1)), 2)).Select
                Selection.Copy
        
            Workbooks("testdatei2.xls").Activate  
            For Copybereich = 1 To 300 'Dritte Schleife  
                If Cells(Copybereich, 1) = Parkname Then
                    Cells(Copybereich, 1).Select
                    Selection.Offset(1, 1).Select
                    Range(Cells(ActiveCell.Row, 2), Cells((ActiveCell.Row + (WRAnzahl - 1)), 2)).Select
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False
            Exit For 'Dritte Schleife  
                End If
            Next 'Dritte Schleife  
        Exit For 'Zweite Schleife  
            End If
                      
        Next 'Zweite Schleife  
    Next 'Erste Schleife  
    
    'Excel Datei schließen  
    Workbooks("_tagesauslesung_zählerstände.xls").Close  
    
    Application.ScreenUpdating = True 'Screen on  
    
End Sub

Gruß Zero

German solved Question VB for Applications Development

Hotly discussed

Wireguard with systemd and nftablesLinuxero - 9 Comments