Thema Datum  Von Nutzer Rating
Antwort
12.12.2020 00:01:33 Maggie
Solved
12.12.2020 00:06:26 Maggie
NotSolved
Rot Bereiche/Spalten untereinander kopieren
12.12.2020 09:40:41 volti
NotSolved
12.12.2020 12:20:46 Maggie
NotSolved

Ansicht des Beitrags:
Von:
volti
Datum:
12.12.2020 09:40:41
Views:
487
Rating: Antwort:
  Ja
Thema:
Bereiche/Spalten untereinander kopieren

Hallo Maggie,

so ganz klar ist mir Dein ANligen noch nicht. Das Beispiel reicht nicht ganz aus...

Deshalb mal eine Idee als Versuch ins Blaue, das Du ggf. noch anpassen kannst.

Code:
 
01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
 
Sub Daten_Uebertragen()
  Dim iZeile As Long, iOutZeile As Long
  Dim WShZ As Worksheet, rBer As Range
  Dim iMaxZl As Long, iMaxSp As Integer

  With Application
     .ScreenUpdating = False
     .EnableEvents = False
     .Calculation = xlCalculationManual
  End With
  
  Set WShZ = ThisWorkbook.Sheets("Tabelle5")                 ' Ziel/Datei-blatt angeben
  iOutZeile = 1                                              ' Zielzeile setzen
  
  With ThisWorkbook.Sheets("Tabelle4")                       ' Quell/Datei-blatt angeben
     iMaxZl = .Cells(Rows.Count, "A").End(xlUp).Row          ' Anzahl der Zeilen ermitteln
     iMaxSp = .Cells(1, Columns.Count).End(xlToLeft).Column  ' Anzahl der Spalten ermitteln
    
     For iSpalte = 2 To iMaxSp
        For iZeile = 2 To iMaxZl
           WShZ.Cells(iOutZeile, "A").Value = .Cells(1, iSpalte).Value
           WShZ.Cells(iOutZeile, "B").Value = .Cells(iZeile, 1).Value
           WShZ.Cells(iOutZeile, "C").Value = .Cells(iZeile, iSpalte).Value
           iOutZeile = iOutZeile + 1
        Next iZeile
     Next iSpalte
  End With
  
  With Application
     .ScreenUpdating = True
     .EnableEvents = True
     .Calculation = xlCalculationAutomatic
  End With
  MsgBox "Fertig", vbInformation
  
End Sub
 
_________
viele Grüße
Karl-Heinz

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
12.12.2020 00:01:33 Maggie
Solved
12.12.2020 00:06:26 Maggie
NotSolved
Rot Bereiche/Spalten untereinander kopieren
12.12.2020 09:40:41 volti
NotSolved
12.12.2020 12:20:46 Maggie
NotSolved