Makro 4 mal laufen lassen?

Bild

Betrifft: Makro 4 mal laufen lassen?
von: thomas
Geschrieben am: 16.08.2015 12:17:04

Hallo Excelfreunde
ich benutze das untenstehende makro. Es kopiert alle werte aus der spalte 2 Tabelle2 in die Spalte a Tabelle3.
Nun möchte ich gern das noch die spalten 7 und 12 aus tabelle2 dazukommen.
zur zeit löse ich es mit
Call Anhang_Kopie_Spalte_7
Call Anhang_Kopie_Spalte_12
ich lasse sozusagen das makro 3 mal laufen. Geht es auch eleganter?
liebe grüsse thomas

Sub Anhang_Kopie()
Dim shQuelle As Worksheet, shZiel As Worksheet
Dim varScratch As Variant
Dim lngQLRS As Long, lngZLR As Long
Dim lngQS As Long, lngQR As Long
Set shQuelle = ThisWorkbook.Sheets("tabelle2")
Set shZiel = ThisWorkbook.Sheets("tabelle3")
For lngQS = 2 To 2 Step 1                                                      'Spalten A=1 bis  _
AS=45
    lngQLRS = shQuelle.Cells(Rows.Count, lngQS).End(xlUp).Row                   'letzte Zeile  _
in der Spalte
    For lngQR = 1 To lngQLRS Step 1                                             'von Zeile1 bis  _
letzte Zeile der Spalte
        varScratch = shQuelle.Cells(lngQR, lngQS).Value
        If varScratch <> "" Then                                                'wenn Zelle  _
nicht leer
            If WorksheetFunction.CountIf(shZiel.Range("A:A"), varScratch) = 0 Then  'wenn Wert  _
in Kopie,Spalte A nicht vorhanden
                lngZLR = shZiel.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 'Zielzeile in  _
Anhang Kopie SpalteA=1 ermitteln
                shZiel.Cells(lngZLR, 1).Value = varScratch                      'Wert in  _
Zielzelle einfügen
            End If
        End If
    Next
Next
Set shQuelle = Nothing
Set shZiel = Nothing
Call Anhang_Kopie_Spalte_7
Call Anhang_Kopie_Spalte_12 
End Sub

Bild

Betrifft: AW: Makro 4 mal laufen lassen?
von: Sepp
Geschrieben am: 16.08.2015 12:40:38
Hallo Thomas,
so?

Sub Anhang_Kopie()
Dim shQuelle As Worksheet, shZiel As Worksheet
Dim varScratch As Variant
Dim lngQLRS As Long, lngZLR As Long
Dim lngQS As Long, lngQR As Long

Set shQuelle = ThisWorkbook.Sheets("tabelle2")
Set shZiel = ThisWorkbook.Sheets("tabelle3")

lngZLR = shZiel.Cells(Rows.Count, 1).End(xlUp).Row + 1

For lngQS = 2 To 12 Step 5
  lngQLRS = shQuelle.Cells(Rows.Count, lngQS).End(xlUp).Row
  For lngQR = 1 To lngQLRS
    varScratch = shQuelle.Cells(lngQR, lngQS).Value
    If varScratch <> "" Then
      If WorksheetFunction.CountIf(shZiel.Range("A:A"), varScratch) = 0 Then
        shZiel.Cells(lngZLR, 1).Value = varScratch
        lngZLR = lngZLR + 1
      End If
    End If
  Next
Next

Set shQuelle = Nothing
Set shZiel = Nothing
End Sub


Gruß Sepp


Bild

Betrifft: super das passt besten dank
von: thomas
Geschrieben am: 16.08.2015 13:02:34
Hallo Sepp,
das passt
vielen dank thomas

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Makro 4 mal laufen lassen?"