Anzeige
Archiv - Navigation
1184to1188
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro Kopieren im Bereich wenn Wert >0

Makro Kopieren im Bereich wenn Wert >0
Milan
Hallo liebe Forum Freunde,
Ich brauche ein Makro mit folgender Aufgabenstellung:
Kopiere
aus Tabelle1
suche im Bereich AS4 bis CG40 (Formeln)
kopiere
nur wenn in
Spalte AS4 bis AS40 Wert größer 0
(Beispiel:
Wenn in Spalte AS4 bis AS10 Wert größer 0
Dann kopiere AS4 bis CG 10 )
Einfügen:
in Tabelle2
suche nächste freie Zelle in der Spalte A
Nur die Werte einfügen
Vielen Dank im Voraus

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Makro Kopieren im Bereich wenn Wert >0
20.11.2010 18:20:03
Josef

Hallo Milan,
probier mal.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub kopieren()
  Dim lngRow As Long, rng As Range
  
  With Sheets("Tabelle1")
    For lngRow = 4 To 40
      If .Cells(lngRow, 45) > 0 Then
        If rng Is Nothing Then
          Set rng = .Range(.Cells(lngRow, 45), .Cells(lngRow, 85))
        Else
          Set rng = Union(rng, .Range(.Cells(lngRow, 45), .Cells(lngRow, 85)))
        End If
      End If
    Next
  End With
  
  If Not rng Is Nothing Then
    With Sheets("Tabelle2")
      rng.Copy .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1)
    End With
  End If
  
  Set rng = Nothing
End Sub

Gruß Sepp

Anzeige
AW: Makro Kopieren im Bereich wenn Wert >0
20.11.2010 18:32:57
Milan
Hallo Sepp,
bist ein Engel, vielen DANK, es funktioniert perfekt.
Gruss
Milan
AW: Makro Kopieren im Bereich wenn Wert >0
20.11.2010 19:06:17
Milan
Hallo Sepp,
ein Problem, habe es in eine Testdatei getestet es hat funktioniert.
Habe es jetzt in meine richtige Tabelle eingespielt, nach dem Einfügen steht in jede eingefügte Zelle(#BEZUG!) . Was habe ich falsch gemacht?
Auch die Formate werden eingefügt ich brauche aber nur die Werte.
So habe ich es verändert (nur Tabellennamme geändert):
Option Explicit
Sub kopieren()
Dim lngRow As Long, rng As Range
With Sheets("Eingabe")
For lngRow = 4 To 40
If .Cells(lngRow, 45) > 0 Then
If rng Is Nothing Then
Set rng = .Range(.Cells(lngRow, 45), .Cells(lngRow, 85))
Else
Set rng = Union(rng, .Range(.Cells(lngRow, 45), .Cells(lngRow, 85)))
End If
End If
Next
End With
If Not rng Is Nothing Then
With Sheets("Historie")
rng.Copy .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1)
End With
End If
Set rng = Nothing
End Sub

Gruss
Milan
Anzeige
AW: Makro Kopieren im Bereich wenn Wert >0
20.11.2010 19:21:40
Josef

Hallo Milan,
sorry, mein Fehler, habe das "nur Werte" überlesen

Sub kopieren()
  Dim lngRow As Long, rng As Range
  
  With Sheets("Eingabe")
    For lngRow = 4 To 40
      If .Cells(lngRow, 45) > 0 Then
        If rng Is Nothing Then
          Set rng = .Range(.Cells(lngRow, 45), .Cells(lngRow, 85))
        Else
          Set rng = Union(rng, .Range(.Cells(lngRow, 45), .Cells(lngRow, 85)))
        End If
      End If
    Next
  End With
  
  If Not rng Is Nothing Then
    With Sheets("Historie")
      rng.Copy
      .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial xlValues
      Application.CutCopyMode = False
    End With
  End If
  
  Set rng = Nothing
End Sub

Gruß Sepp

Anzeige
AW: Makro Kopieren im Bereich wenn Wert >0
20.11.2010 19:30:11
Milan
SUPER!
jetzt läufts!!
DANKE SEPP
Gruss
Milan

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige