MS-Office-Forum
Google
   

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads Der Renner, 11 Entwicklertools für Access, Tipps & Trick und offene Datenbanken zum einzigartigen Preis.
Themen-Optionen Ansicht
Alt 12.09.2017, 09:58   #1
remix92
MOF User
MOF User
Standard VBA - Kopieren und einfügen

Hi Zusammen,

ich hätte eine Frage bezüglich eines Kopiervogangs bei dem ich nicht weiterkomme..

Ich habe in einem Sheet "A" ab Spalte 3 Werte Stehen, die ich gern in andere Sheets kopieren möchte.
In der Zeile 1 Sind auch die Überschriften vorhanden, die die jeweiligen Excel Sheets beinhalten in die sie kpiert werden müssen..
DH. Zb müssen die Daten von
C1: C19 in Sheet "1" kopiert werden
D1: D19 in Sheet "2" kopiert werden
E1: E19 in Sheet "3" kopiert werden

wie oft kopiert werden muss, ist in der Variable "Anzahl_A" definiert.

Darüberhinaus muss in jedes Sheet mehrmals die Werte eingefügt werden. Wie oft in ein Sheet eingefügt werden muss, ist in "Anzahl_F" definiert.
Eingefügt wird immer in
"B2",
"B13",
"B24",
usw. ( dh, immer + 11 Zeilen)
das immer transponiert

Ich schaffe das alles für das Sheet "1" , nun weiß ich nicht wie ich Die Einträge
von Spalte "D" in Sheet "2"
von Spalte "E" in Sheet "3"
usw kopieren kann...

PHP-Code:

Sub Test()

Dim n As Integer
Dim i 
As Integer
Dim s 
As Integer
Dim Anzahl_A 
As Integer
Dim Anzahl_F 
As Integer
Dim Anzahl_L 
As Integer
Dim t 
As Integer
Dim w 
As Integer




Anzahl_A 
Worksheets("Dummy").Range("D3")
Anzahl_F Worksheets("Dummy").Range("d4")
Anzahl_L Worksheets("Dummy").Range("d5")


2
3
3


    
For 1 To Anzahl_F
    Sheets
("A").Select
    Range
(Cells(1i), Cells(Anzahl_L 1i)).Select
    Selection
.Copy
    Worksheets
(w).Select
    Cells
(s2).Select
        Selection
.PasteSpecial Paste:=xlPasteAllOperation:=xlNoneSkipBlanks:= _
        False
Transpose:=True
     s 
11 n
       Next n
    
'w = 3 + t
    '
t

End Sub 
Wäre für jeden Tipp dankbar

Gruß
Angehängte Dateien
Dateityp: xlsm Test_kopieren.xlsm (37,8 KB, 3x aufgerufen)
remix92 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2017, 11:18   #2
BoskoBiati
MOF Profi
MOF Profi
Standard

Hi,

das ginge z.B. so:

Code:

Sub Test()

Dim LoAnz As Long
Dim loSchleif As Long
Dim loN As Long
Dim shZ As Worksheet
Dim strName As String
loN = 3

With Sheets("A")
    Do While loN < 6
        LoAnz = Sheets("Dummy").Cells(loN, 4) - 1
            strName = "" & .Cells(1, loN).Value & ""
            Set shZ = Sheets(strName)
            .Range(.Cells(2, loN), .Cells(19, loN)).Copy
            For loSchleif = 0 To LoAnz
                shZ.Cells(2 + loSchleif * 11, 3).PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks:=False, Transpose:=True
                shZ.Cells(2 + loSchleif * 11, 2) = .Cells(1, loN).Value
            Next
        loN = loN + 1
    Loop
End With
End Sub

__________________

Gruß

Edgar
Ich weiß, daß ich nichts weiß!
BoskoBiati ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2017, 11:31   #3
remix92
Threadstarter Threadstarter
MOF User
MOF User
Standard

Vielen Dank für deine Antwort

Nur versteh ich dein Makro nicht so genau...
Bin nicht so fit in Vba ...

Könntest du eventuell es ein wenig auskommentieren ?
zb wird es für Sheet "1" nur 10 mal eingefügt
für Sheet "2" 19 Mal was korrekt ist
für Sheet "3" 18 Mal, was einmal zu wenig ist
ab Sheet "4" passiert leider nichts ...

Geändert von remix92 (12.09.2017 um 11:34 Uhr).
remix92 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2017, 12:17   #4
BoskoBiati
MOF Profi
MOF Profi
Standard

Hi,

1. steht in Deiner Datei für Anzahl A 10, also 10 Kopien!
2. gibt es In Dummy nur Daten für 3Blätter.

Code:

Sub Test()

Dim LoAnz As Long
Dim loSchleif As Long
Dim loN As Long
Dim shZ As Worksheet
Dim strName As String
loN = 3
Application.ScreenUpdating = False
With Sheets("A")
    Do While loN < 13
        LoAnz = Sheets("Dummy").Cells(loN, 4) - 1
            strName = "" & .Cells(1, loN).Value & ""
            Set shZ = Sheets(strName)
            .Range(.Cells(2, loN), .Cells(19, loN)).Copy
            For loSchleif = 0 To LoAnz
                shZ.Cells(2 + loSchleif * 11, 3).PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks:=False, Transpose:=True
                shZ.Cells(2 + loSchleif * 11, 2) = .Cells(1, loN).Value
            Next
        loN = loN + 1
    Loop
End With
Application.ScreenUpdating = True
End Sub

__________________

Gruß

Edgar
Ich weiß, daß ich nichts weiß!

Geändert von BoskoBiati (12.09.2017 um 12:20 Uhr).
BoskoBiati ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2017, 12:41   #5
remix92
Threadstarter Threadstarter
MOF User
MOF User
Standard

Es tut mir leid, dann hab ich mich vorhin falsch ausgedrückt!

Anzahl_F: Ist Die Anzahl wie oft die entsprechende Spalte von "A" in ein Sheet eingefügt werden muss. In Diesem Fall muss die kopie in jedes Sheet 19 Mal eingefügt werden.
Anzahl_A: Definiert die Anzahl, wieviele "Spalten" die Tabelle in Sheet "A" hat.

Das bedeutet insgesamt:
von Sheet "A" muss:
"C1 : C19" in Sheet "1" 19 mal kopiert werden
"D1 : D19" in Sheet "2" 19 mal kopiert werden
"E1 : E19" in Sheet "3" 19 mal kopiert werden
"F1 : F19" in Sheet "4" 19 mal kopiert werden
"G1 : G19" in Sheet "5" 19 mal kopiert werden
"H1 : H19" in Sheet "6" 19 mal kopiert werden
"I1 : I19" in Sheet "7" 19 mal kopiert werden
"J1 : J19" in Sheet "8" 19 mal kopiert werden
"K1 : K19" in Sheet "9" 19 mal kopiert werden
"L1 : L19" in Sheet "10" 19 mal kopiert werden

Ich hoffe, es ist nun verstädnlcih

Gruß
remix92 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2017, 13:06   #6
BoskoBiati
MOF Profi
MOF Profi
Standard

Hi;

Code:

Sub Test()

Dim LoAnz As Long
Dim loSchleif As Long
Dim loN As Long
Dim shZ As Worksheet
Dim strName As String
loN = 1
Application.ScreenUpdating = False
With Sheets("A")
    Do While loN < Sheets("Dummy").Cells(3, 4) + 1
        LoAnz = Sheets("Dummy").Cells(4, 4) - 1
            strName = "" & .Cells(1, loN + 2).Value & ""
            Set shZ = Sheets(strName)
            .Range(.Cells(2, loN + 2), .Cells(19, loN + 2)).Copy
            For loSchleif = 0 To LoAnz
                shZ.Cells(2 + loSchleif * 11, 3).PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks:=False, Transpose:=True
                shZ.Cells(2 + loSchleif * 11, 2) = .Cells(1, loN + 2).Value
            Next
        loN = loN + 1
    Loop

End With

Application.ScreenUpdating = True
End Sub

__________________

Gruß

Edgar
Ich weiß, daß ich nichts weiß!
BoskoBiati ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2017, 13:14   #7
remix92
Threadstarter Threadstarter
MOF User
MOF User
Standard

Vielen Dank für die Mühe
Nun wird alles genau 19 Mal kopiert, aber dennoch ist ein kleiner macker drinnen..

Es wird immer nur die letzte Spalte "L2 : L19" in alle Sheets kopiert, wobei die Überschriften richtig zugeordnet sind!

Vielen dank für deine Hilfe, wäre noch wunderbar, wenn dieses kleine Problem behoben werden könnte

Gruß
remix92 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2017, 13:35   #8
BoskoBiati
MOF Profi
MOF Profi
Standard

Hi,

bei mir nicht!

__________________

Gruß

Edgar
Ich weiß, daß ich nichts weiß!
BoskoBiati ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2017, 13:44   #9
remix92
Threadstarter Threadstarter
MOF User
MOF User
Standard

ah tut mir leid ...
Mein Fehler. Läuft einwandfrei.
Vielen Dank dir !!!

Gruß
remix92 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2017, 16:18   #10
remix92
Threadstarter Threadstarter
MOF User
MOF User
Standard

Es tut mir leid, dass ich dich beöästige ...
Eine Letzte Frage hätte ich noch zwecks Kopiervorgang.

Möchte ungern ein neues Thread aufmachen, da sich meine Fragestellung sehr an die vorherige Frage anlehnt.

Ich würde gerne von den Sheets "1- 10" jeweils die Einträge in der Spalte C kopieren und in das Sheet "Ergebnis" einfügen.

Das wären aber nun die Einträge von C12,C23,C34,C45,...,C210,
dh, alle Einträge mit einem Zeilenabstand von 11 Zeilen. (insgesamt 19 Einträge müssen kopiert werden)

Ebenso werden die Werte nun "transponiert" eingefügt.

Das habe ich mit einem Makro, welches mir die Werte von Sheet 1 kopiert und in das Sheet "Ergebnis" einfügt erledigt!

Wie kann ich dieses Schema für die weiteren Sheets "2-10" so übernehmen, dass die Werte von
Sheet "2" kopiert und in das Sheet "Ergebnis" ab D4
Sheet "3" kopiert und in das Sheet "Ergebnis" ab D5
Sheet "4" kopiert und in das Sheet "Ergebnis" ab D6
Sheet "5" kopiert und in das Sheet "Ergebnis" ab D7
....
Sheet "10" kopiert und in das Sheet "Ergebnis" ab D12
"transponiert" eingefügt werden ?

PHP-Code:

Sub ergebnis_kopieren()
Dim n As Long
Dim i 
As Long
Dim s 
As Long
Dim p 
As Long
Dim WS 
As Worksheet


Dim Anzahl_A 
As Integer
Dim Anzahl_F 
As Integer
Dim Anzahl_L 
As Integer


12
3
4


Anzahl_A 
Worksheets("Dummy").Range("D3")
Anzahl_F Worksheets("Dummy").Range("d4")
Anzahl_L Worksheets("Dummy").Range("d5")



For 
1 To Anzahl_F
Sheets
("1").Select
Cells
(i3).Copy


Sheets
("Ergebnis").Select
Cells
(3s).Select
    Selection
.PasteSpecial Paste:=xlPasteAllUsingSourceThemeoperation:=xlNone _
        
skipblanks:=False
    Selection
.PasteSpecial Paste:=xlPasteValuesoperation:=xlNoneskipblanks _
        
:=False


12 11 n
n
Next n


End Sub 
Angehängte Dateien
Dateityp: xlsm Test_kopieren.xlsm (86,4 KB, 2x aufgerufen)
remix92 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2017, 20:25   #11
BoskoBiati
MOF Profi
MOF Profi
Standard

Hi,

so:

Code:

Sub ergebnis_kopieren()
Dim loA As Long
Dim shQ As Worksheet
Dim shz As Worksheet
Dim loN As Long
Set shz = Sheets("Ergebnis")
For loN = 1 To 10
    Set shQ = Sheets("" & loN & "")
    For loA = 1 To 19
        shz.Cells(2 + loN, 3 + loA) = shQ.Cells(loA * 11 + 1, 3)
    Next
Next
End Sub

__________________

Gruß

Edgar
Ich weiß, daß ich nichts weiß!
BoskoBiati ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 13.09.2017, 10:36   #12
remix92
Threadstarter Threadstarter
MOF User
MOF User
Standard

Vielen Dank

Nur habe ich ein kleines Problem...

undzwar hab ich die beiden Schleifen Enden angepasst und habe es in mein Orginalfile versucht auszuführen....

Die Files die ich hier hochgeladen habe waren nur Testbeispiele mit veränderten Worksheet Namen, da die Orginalen Worksheet Namen sehr lang sind...

Nichtsdestotrotz sind die namen die sich Spalte C im Sheet "Ergebnis" befinden, die gleichen, wie Die Worksheet Namen aus denen kopiert werden muss...

PHP-Code:

Sub ergebnis_kopieren()
Dim loA As Long
Dim shQ 
As Worksheet
Dim shz 
As Worksheet
Dim loN 
As Long
Dim Anzahl_A 
As Long
Dim Anzahl_F 
As Long
Dim Anzahl_L 
As Long

Anzahl_A 
Worksheets("Dummy").Range("D3")
Anzahl_F Worksheets("Dummy").Range("d4")
Anzahl_L Worksheets("Dummy").Range("d5")

Set shz Sheets("Ergebnis")
For 
loN 1 To Anzahl_A
    Set shQ 
Sheets("" loN "")
    For 
loA 1 To Anzahl_F
        shz
.Cells(loNloA) = shQ.Cells(loA 11 13)
    
Next
Next
End Sub 
Dennoch bekomme ich die Fehlermeldung:
"Index außerhalb des gültigen Bereichs"

Woran liegt das ?
remix92 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 13.09.2017, 10:48   #13
BoskoBiati
MOF Profi
MOF Profi
Standard

Hi,

mein Code geht davon aus, dass die Blätter 1, 2, 3 usw. heißen.

__________________

Gruß

Edgar
Ich weiß, daß ich nichts weiß!
BoskoBiati ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 13.09.2017, 11:15   #14
remix92
Threadstarter Threadstarter
MOF User
MOF User
Standard

Aso Okay

PHP-Code:

Sub ergebnis_kopieren()
Dim loA As Long
Dim shQ 
As Worksheet
Dim shz 
As Worksheet
Dim WS 
As Worksheet
Dim loN 
As Long
Dim Anzahl_A 
As Long
Dim Anzahl_F 
As Long
Dim Anzahl_L 
As Long
Dim a 
As Long

7
Anzahl_A 
Worksheets("Dummy").Range("D3")
Anzahl_F Worksheets("Dummy").Range("d4")
Anzahl_L Worksheets("Dummy").Range("d5")


Set shz Sheets("Ergebnis")
For 
loN 1 To Anzahl_A
    Set shQ 
Sheets("" loN "")
    For 
loA 1 To Anzahl_F
        shz
.Cells(loNloA) = Worksheets(a).Cells(loA 11 13)
    
Next
   a 
loN
Next

End Sub 
Habe es nun so gelöst

Vielen Dank für Alles!!!
remix92 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 15:32 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.

Copyright ©2000-2010 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günther Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.
Beachten Sie bitte auch unsere Nutzungsbedingungen.