VBA - Excel - Alle Worksheets durchlaufen und Werte in Zellen schreiben

Jedes Worksheet des Excel-Sheets abarbeiten, jeweils die letzte Zeile auslesen und gefundene Werte in statische Felder schreiben

Hallo ihr Profis,

ich habe ein Problem mit einem Excel-Makro. Muss dazu sagen, dass mein letztes Mal VBA ~ 6 Jahre zurückliegt. Bin also total eingerostet und muss mich jetzt auch an euch wenden

Was will ich machen?
Ich habe eine Excel-Datei mit mehreren Worksheets (5). Ein Makro soll beim Öffnen der Datei durch alle Worksheets laufen, jeweils die letzte Zeile auslesen, aus drei Spalten der letzten Zeile die Werte auslesen, und im selben Worksheet an anderer Stelle einfügen.

Was ist mein Problem?
Nun, die Funktion habe ich schon Mal "auto_open" genannt, dass sie beim Öffnen auch automatisch ausgeführt wird. Meine Schleife läuft durch alle Worksheets (ich habe als Debug eingebaut, dass er mir den Namen des Worksheets in einer MsgBox anzeigt), die Änderungen werden aber immer nur im 1. Worksheet durchgeführt. Ich habe meinen Code wirklich mehrmals durchgesehen jetzt, finde aber nicht, wo hier statisch auf immer das 1. Worksheet verwiesen wird ...

Sub auto_open()

  'Variablendeklaration  
  Dim objWks    As Worksheet
  Dim nCol      As Integer
  Dim nLastRow  As Long
  Dim nCounter  As Integer
  Dim nNumWS    As Integer
    
  'Anzahl der Worksheets auslesen  
  nNumWS = ActiveWorkbook.Worksheets.Count
    
  For nCounter = 1 To nNumWS
    
  'Das Worksheet aufgreifen und als Objekt definieren  
  Set objWks = ActiveWorkbook.Worksheets(nCounter)
    
  'Spalte A  
  nCol = 1
  With objWks
      If Application.WorksheetFunction.CountA( _
              .Columns(nCol).EntireColumn) > 0 Then

          If Len(.Cells(.Rows.Count, nCol).Value) = 0 Then
              nLastRow = .Cells(.Rows.Count, nCol).End(xlUp).Row
          Else
              nLastRow = .Rows.Count
          End If
          'Variabel abgegriffene Werte in die statischen Felder schreiben  
          objWks.Cells(2, 7).Value = objWks.Cells(nLastRow, nCol)
         
      End If
  End With
  
  'Spalte B  
  nCol = 2
  With objWks
      If Application.WorksheetFunction.CountA( _
              .Columns(nCol).EntireColumn) > 0 Then

          If Len(.Cells(.Rows.Count, nCol).Value) = 0 Then
              nLastRow = .Cells(.Rows.Count, nCol).End(xlUp).Row
          Else
              nLastRow = .Rows.Count
          End If
          'Variabel abgegriffene Werte in die statischen Felder schreiben  
          objWks.Cells(3, 7).Value = objWks.Cells(nLastRow, nCol)
         
      End If
  End With
  
  'Spalte F  
  nCol = 6
  With objWks
      If Application.WorksheetFunction.CountA( _
              .Columns(nCol).EntireColumn) > 0 Then

          If Len(.Cells(.Rows.Count, nCol).Value) = 0 Then
              nLastRow = .Cells(.Rows.Count, nCol).End(xlUp).Row
          Else
              nLastRow = .Rows.Count
          End If
          'Variabel abgegriffene Werte in die statischen Felder schreiben  
          objWks.Cells(4, 7).Value = objWks.Cells(nLastRow, nCol)
         
      End If
  End With
    
 'Debugfunktion (Anzeigen des Worksheet-Namens  
 MsgBox ActiveWorkbook.Worksheets(nCounter).Name
   Set objWks = Nothing
   Next nCounter
    
'//EOF  
End Sub

Ich wäre um jede Hilfe dankbar!

brgds

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 63623

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

Ausgedruckt am: 22.11.2024 um 09:11 Uhr

2 Kommentare

Neuester Kommentar

Hallo Forsberg21!

Die schlechte Nachricht vorweg: Dein Code funktioniert bei mir ...

Zwar könnte man das Ganze wie folgt etwas straffen, aber das ist auch nur Kosmetik:

Option Explicit

'Variablendeklaration  
Dim objWks    As Worksheet
Dim nLastRow  As Long
Dim nCounter  As Integer
Dim nNumWS    As Integer
    
Sub auto_open()

'Anzahl der Worksheets auslesen  
nNumWS = ActiveWorkbook.Worksheets.Count
    
For nCounter = 1 To nNumWS
    
    'Das Worksheet aufgreifen und als Objekt definieren  
    Set objWks = ActiveWorkbook.Worksheets(nCounter)
    
    'Spalte A -> Zeile 2, Spalte G  
    Call Eintragen(1, 2, 7)
    'Spalte B -> Zeile 3, Spalte G  
    Call Eintragen(2, 3, 7)
    'Spalte F -> Zeile 4, Spalte G  
    Call Eintragen(6, 4, 7)
    
    Set objWks = Nothing
Next 'nCounter  
    
End Sub

Sub Eintragen(nCol As Integer, nTRow As Integer, nTCol As Integer)
With objWks
      If Application.WorksheetFunction.CountA( _
              .Columns(nCol).EntireColumn) > 0 Then

          If Len(.Cells(.Rows.Count, nCol).Value) = 0 Then
              nLastRow = .Cells(.Rows.Count, nCol).End(xlUp).Row
          Else
              nLastRow = .Rows.Count
          End If
          'Variabel abgegriffene Werte in die statischen Felder schreiben  
          objWks.Cells(nTRow, nTCol).Value = objWks.Cells(nLastRow, nCol)
         
      End If
  End With
End Sub

Mir fällt leider keine vernünftige Erklärung ein, warum nur die erste Tabelle bearbeitet werden sollte.

Grüße
bastla

Hallo!

Es war die pure Dummheit. Das Makro funktionierte die ganze Zeit einwandfrei, ich hatte nur die Ausrichtung der Felder so gehabt, dass ich es nicht gleich gesehen habe.

Trotzdem Danke für die Hilfe.

Problem gelöst, Thread kann geschlossen werden.

brgds

gelöst Frage VB for Applications Entwicklung

Mehr von Forsberg21

Active Directory - Freigabe auf anderem Server - Holt Objekte nichtForsberg21 - 5 Kommentare

ActiveDirectory - Neu-Integration der PCs - easy?Forsberg21 - 11 Kommentare

Outlook 2003: Gruppen im An-Feld nicht auflösenForsberg21 - 1 Kommentar

IE zeigt keine Grafiken, oder doch?Forsberg21 - 3 Kommentare

Heiß diskutiert