Makro

  • Makro von Ronald vom 01.04.2005 18:50:13
Bild

Betrifft: Makro
von: Ronald
Geschrieben am: 01.04.2005 18:50:13
Hallo,
habe einen VBA-Code den ich ein bissl ändern möchte. Habe viele Adressdaten in einer Tabelle (Aufbau: Name,Name2,Strasse,PLZ,Ort....usw.) viele von denen sind farbig markiert und ich möchte doppelte Einträge in eine zweite Tabelle importieren , dies geschieht zwar aber er nimmt nur die Spalte A und nicht die restlichen Splaten sowie die farbig markierten Felder ebenso nicht.
Folgenden Code hab ich:
Option Explicit


Sub GleicheUebertragen()
   Dim wks As Worksheet
   Dim var As Variant, vValue As Variant
   Dim iRow As Integer, iRowT As Integer
   Set wks = ActiveSheet
   Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
   iRow = 1
   Do Until IsEmpty(wks.Cells(iRow, 1))
      vValue = wks.Cells(iRow, 1).Value
      If WorksheetFunction.CountIf(wks.Columns(1), vValue) > 1 Then
         var = Application.Match(vValue, Columns(1), 0)
         If IsError(var) Then
            iRowT = iRowT + 1
            Cells(iRowT, 1).Value = vValue
         End If
      End If
      iRow = iRow + 1
   Loop
End Sub

Danke schon einmal im vorraus.....
Ronald
Bild

Betrifft: AW: Makro
von: Beni
Geschrieben am: 01.04.2005 21:14:31
Hallo Ronald,
ich habe einiges an Deinem Code geändert.
Gruss Beni

Sub GleicheUebertragen()
   Dim wks As String
   Dim var As Variant, vValue As Variant
   Dim iRow As Integer, iRowT As Integer
  wks = ActiveSheet.Name
   With Sheets(wks)
   Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
For iRow = 1 To .Cells(65536, 1).End(xlUp).Row
   ls = .Cells(iRow, 256).End(xlToLeft).Column
      vValue = .Cells(iRow, 1).Value
      If WorksheetFunction.CountIf(.Columns(1), vValue) > 1 Then
            iRowT = Cells(65536, 1).End(xlUp).Row + 1
            If IsEmpty(Cells(1, 1)) Then iRowT = 1
            Range(.Cells(iRow, 1), .Cells(iRow, ls)).Copy Cells(iRowT, 1)
      End If
Next iRow
End With
End Sub

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Schützen von Arbeitsmappen mit Makrozugriff"