VBA Transponieren

Sub Projekt() Dim wsZiel As Worksheet Dim wsQuelle As Worksheet Set wsZiel = ActiveWorkbook.ActiveSheet Set wsQuelle = Workbooks.Open(Filename:="C:\probe.xls").Worksheets("FFT CH1") wsQuelle.Activate For A = 11 To 19 Worksheets(A).Range("C2:C3202").Copy Application.CutCopyMode = False wsZiel.Activate wsZiel.Range("D3").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Next A wsQuelle.Parent.Close Set wsQuelle = Nothing Set wsZiel = Nothing End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

wenn Du
Application.CutCopyMode = False machst ist speicher gelöscht, oder sehe ich das falsch?
Select, Activate usw. ist in VBA zu 99,8% nicht notwendig.
Der Cursor ist kein Hund der überall rumgeführt werden muss.
Hinweise zu select usw. Hajo-Excel.de
Hinweise zu select usw. Online-Excel.de
Hinweise zu select usw. Online-Excel.de
Der Cursor ist kein Hund, der überall rum geführt werden muss.

Ich gebe keinen Dank für eine Rückmeldung, da ich durch solche Beiträge nicht meine Beitragszahl erhöhen muss.
Also ich schreibe keine Beiträge mit dem Betreff "Gerne u. Danke für die Rückmeldung....."
Rückmeldung ist ja in der Heutigen Zeit nicht üblich und die wenigen die eine Rückmeldung geben,
mögen mir das verzeihen, das kein Danke für eine Rückmeldung kommt.
Beiträge von Werner, Luc, robert und folgende lese ich nicht.

Option Explicit Sub Projekt() Dim wsZiel As Worksheet, wsQuelle As Worksheet, a As Long, i As Long Set wsZiel = ThisWorkbook.Worksheets("Tabelle1") 'Blattname anpassen Set wsQuelle = Workbooks.Open(Filename:="C:\probe.xls").Worksheets("FFT CH1") i = 3 With wsQuelle For a = 11 To 19 .Worksheets(a).Range("C2:C3202").Copy wsZiel.Range("D" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Application.CutCopyMode = False i = i + 1 Next a End With wsQuelle.Close False Set wsQuelle = Nothing Set wsZiel = Nothing End Sub

Ich hätte versucht das ganze noch zu erweitern, dass mehrere Datein (nur durch unterschiedliche Bezeichnung) ausgelesen werden. Das Makro fuktioniert auch soweit nur die Zeile:
wsZiel.Range("D3").End(xlDown).i = ActiveCell.Row
passt ihm nicht. Hätte damit versucht die letzte freie Zelle in der Spalte D zu ermitteln, damit es zu keiner überschreibung kommt. Wäre sehr dankbar wenn hierzu noch jemand eine Anmerkung hätte.

Sub Inet()
Dim wsZiel As Worksheet, wsQuelle As Worksheet, a As Long, i As Long
Set wsZiel = ThisWorkbook.Worksheets("SR")
For b = 1 To 9
Set wsQuelle = Workbooks.Open(Filename:="C:\20180109Float6UniGlasClassic_FFT_sr0" & b & " _
_Allgemein_.xls").Worksheets("FFT CH1")
wsZiel.Range("D3").End(xlDown).i = ActiveCell.Row
With wsQuelle
For a = 11 To 19
Worksheets(a).Range("C2:C3202").Copy
wsZiel.Range("D" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
i = i + 1
wsQuelle.Parent.Close
Next a
End With
Next b
Set wsQuelle = Nothing
Set wsZiel = Nothing
End Sub

Sub Inet() Dim wsZiel As Worksheet, wsQuelle As Worksheet, a As Long, loLetzte As Long Set wsZiel = ThisWorkbook.Worksheets("SR") For b = 1 To 9 Set wsQuelle = Workbooks.Open(Filename:="C:\" & _ "20180109Float6UniGlasClassic_FFT_sr0" & b & "_Allgemein_.xls").Worksheets("FFT CH1") loLetzte = wsZiel.Cells(wsZiel.Rows.Count, 4).End(xlUp).Offset(1, 0).Row If loLetzte

Beliebteste Forumthreads (12 Monate)

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread