Transponieren

Hall Leute
Suche ein Lösung zu meinem Problem
Für verschieden ist es ein Kinderspiel :-) für mich nicht
Habe eine Mappe die heisst Archiv
Die andere Mappen heissen Daten KW1 (Kw bedeutet =Kalenderwoche)bis KW 52
Jetzt möchte ich aber von der Mappe "Archiv" aus durch einen Button (vba)bestimmte zellen aus den geschlossenen Mappen Daten Kw1 bis Daten KW 52 auslesen und sie hineinkopieren.Da die Daten in den KW Mappen alle in Vertikaler Richtung eingetragen sind muss ich sie beim Kopieren in die Mappe "Archiv"
.Pastespecial die Transponieren auf True setzen da sie dann in horizontaler Richtung eingetragen werden.
Die Zellen zum kopieren sind (b3:ay3,b6:ay9,b106:ay111).
Wäre euch sehr Dankbar für eure Mithilfe.
MFG
Patrick

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Transponieren

25.09.2007 21:27:00

Hajo_Zi

AW: Transponieren

26.09.2007 06:56:00

Patrick

Hi Hajo
Hier habe ich ein code der funzt wunderbar mit geschlossenen Arbeitsmappen.Den verwende ich für einzelne zellen.


Private Sub CommandButton1_Click()
Dim intAnzahlDateien As Integer
Dim strTabelleName As String
Dim objDateiSuche As Object
Dim strDateiPfad As String
Dim strDateiName As String
Dim wksBlatt As Worksheet
Dim intSpalte As Integer
Dim strZelle As String
On Error GoTo Aus_Datei_Lesen_Error
strDateiPfad = "\\server\Datei\KW Folder\"
strTabelleName = "Archiv"
strZelle = "AZ106:AZ113"
strZelle = Range(strZelle).Address(RowAbsolute:=True, ColumnAbsolute:=True, ReferenceStyle:= _
xlR1C1)
Set wksBlatt = ThisWorkbook.Worksheets("Tabelle1")
intSpalte = wksBlatt.Cells(2, Columns.Count).End(xlToLeft).Column
wksBlatt.Cells.Clear
Set objDateiSuche = Application.FileSearch
With objDateiSuche
.NewSearch
.LookIn = strDateiPfad
.SearchSubFolders = False
.FileType = msoFileTypeAllFiles
.Filename = "*.xls"
If .Execute() > 0 Then
For intAnzahlDateien = 1 To .FoundFiles.Count
strDateiName = Dir(.FoundFiles(intAnzahlDateien))
If strDateiName  ThisWorkbook.Name Then
With wksBlatt.Range(Cells(1, intSpalte), Cells(1 + 7, intSpalte))
.FormulaArray = "='" & strDateiPfad & "[" & strDateiName & "]" &  _
strTabelleName & "'!" & strZelle
.Value = .Value
End With
intSpalte = intSpalte + 1
End If
Next intAnzahlDateien
End If
Sheets("Tabelle1").Select
End With
Call updatechart
Range("a1").Select
Set objDateiSuche = Nothing
Set wksBlatt = Nothing
On Error GoTo 0
Exit Sub
Aus_Datei_Lesen_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
Set objDateiSuche = Nothing
Set wksBlatt = Nothing
End Sub

Wenn du es schaffst könntest du mir den Bitte für die oben genannten zellen realisieren .
Ich dank Dir im Voraus
MFG
Patrick

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Transponieren

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread