VBA Problem
27.02.2006 08:54:54
Stefan
ich habe folgendes Makro, dass mir nach Auswahl gewünschter Spalten auf einem Tabellenblatt diese in ein separates übernommen werden. Allerdings werden immer nur die werte übernommen. wie kann ich das Makro dahingehend umbauen, dass mir neben den Werten auch Formeln und Formate übernommen werden?
Hier der Quell-Code:
Option Explicit
Sub BenutzerAuswählen()
Generieren 0, True
End
Sub
Sub Generieren(intEmpfänger As Integer, bolAuswahlZeigen As Boolean)
Dim strZelle As String
Dim intLänge As Integer
Dim strReports As String
Dim intAuswahl As Integer
If bolAuswahlZeigen Then
DialogSheets("Choose_Benutzer").Show
intEmpfänger = DialogSheets("Choose_Benutzer").ListBoxes("Liste").ListIndex
End If
Application.ScreenUpdating = False
Application.Calculation = xlManual
If intEmpfänger Then
Dim i%
Dim Spalte_Ziel%
Dim Spalte_Quell%
Dim Spalte_Hier%
Spalte_Quell = 2
Spalte_Ziel = 2
Spalte_Hier = 2
Sheets("Ziel").Range("B2:IV10000").ClearContents
Do
Spalte_Hier = 2
Do
If Sheets("Hier").Cells(2, Spalte_Hier) = Sheets("Quell").Cells(intEmpfänger + 1, Spalte_Quell) Then
For i = 2 To 5 'hier kannst du die Anzahl der Zeilen festlegen, die ein Jahresdatensatz hat
Sheets("Ziel").Cells(i, Spalte_Ziel) = Sheets("Hier").Cells(i, Spalte_Hier)
Next i
Spalte_Ziel = Spalte_Ziel + 1
Exit Do
End If
Spalte_Hier = Spalte_Hier + 1
Loop Until Sheets("Hier").Cells(2, Spalte_Hier) = "" 'hier wird das Jahr in deiner Liste "Hier" gesucht bis nach rechts nichts mehr steht.
Spalte_Quell = Spalte_Quell + 1
Loop Until Sheets("Quell").Cells(intEmpfänger + 1, Spalte_Quell) = "" 'hier wird solange durchgearbeitet bis in deiner Benutzertabelle keine Jahre rechts rüber mehr auftauchen
End If
Application.Calculation = xlAutomatic
End Sub
Dazu die entsprechende Datei: https://www.herber.de/bbs/user/31422.xls
Gruß Stefan