Gruppen
- Top Gruppen
- Betriebsysteme
- Windows classik
- Linux
- BS-Sonstige
- Software
- Datenbanken
- Bildbearbeitung
- Audio/mp3/Video
- Security/Viren
- SW-Sonstige
- Hardware
- Mainboard/CPU
- Grafikkarten
- Peripherie
- Laptop/Notebook
- HW-Sonstiges
- Netzwerk
- Telefon,ISDN,Modem
- W-Lan
- NW-Sonstiges
- Programmierung
- PHP,ASP,Perl...
- Java,C++...
- Webseiten/HTML
- Sonstiges
- PC-Sonstiges
- Plauderecke
- SN Intern
- Test
/ Forum / Tabellenkalkulation
Tabellenkalkulation
Fragevon sas vom 11.03.2019, 08:41 Options
Daten aus Tabellen übertragen
Hallo,
ich benötige mal wieder eure Hilfe.
Ich habe folgenden VBA-Code:
Sub Daten()
Dim StName As String
StName = ActiveSheet.Name
With ThisWorkbook.Worksheets(StName)
Workbooks.Open Filename:="D:\Meine Dateien\SRW.xls"
.Range("C2:C6").Copy ActiveSheet.Range("C1:C5")
.Range("B2:B6").Copy ActiveSheet.Range("F1:F5")
.Range("D2:D6").Copy ActiveSheet.Range("G1:G5")
End With
With Windows("SRW.xls").Activate
Range("D1:D5").Value = 0
Range("E1:E5").Value = 6.3
End With
End Sub
Die eine Datei (RW.xls) enthält 12 Tabellen mit den Monaten Januar bis Dezember und bestimmten Werten.
Die Werte aus allen 12 Tabellen sollen nun mittels eines Makros in die Datei SRW.xls (mit den Monatstabellen Jan - Dez) übertragen werden. Der obige Code funktioniert leider nur für eine Tabellenübertragund. Ich habe bisher leider keine Idee, wie ich diesen erweitern oder umstellen kann.
Bsp.
Tabelle Januar (aus Datei RW.xls) nach Jan (aus Datei SRW.xls)
B C D -> A B C D E F G
5 KM 1,40 KM 0 6.3 5 1,40
5 KM 1,40 KM 0 6.3 5 1,40
6 WF 1,00 WF 0 6.3 6 1,00
Tabelle Februar -> Feb usw.
Danke schon mal für eure Hilfe.
Gruss sas
ich benötige mal wieder eure Hilfe.
Ich habe folgenden VBA-Code:
Sub Daten()
Dim StName As String
StName = ActiveSheet.Name
With ThisWorkbook.Worksheets(StName)
Workbooks.Open Filename:="D:\Meine Dateien\SRW.xls"
.Range("C2:C6").Copy ActiveSheet.Range("C1:C5")
.Range("B2:B6").Copy ActiveSheet.Range("F1:F5")
.Range("D2:D6").Copy ActiveSheet.Range("G1:G5")
End With
With Windows("SRW.xls").Activate
Range("D1:D5").Value = 0
Range("E1:E5").Value = 6.3
End With
End Sub
Die eine Datei (RW.xls) enthält 12 Tabellen mit den Monaten Januar bis Dezember und bestimmten Werten.
Die Werte aus allen 12 Tabellen sollen nun mittels eines Makros in die Datei SRW.xls (mit den Monatstabellen Jan - Dez) übertragen werden. Der obige Code funktioniert leider nur für eine Tabellenübertragund. Ich habe bisher leider keine Idee, wie ich diesen erweitern oder umstellen kann.
Bsp.
Tabelle Januar (aus Datei RW.xls) nach Jan (aus Datei SRW.xls)
B C D -> A B C D E F G
5 KM 1,40 KM 0 6.3 5 1,40
5 KM 1,40 KM 0 6.3 5 1,40
6 WF 1,00 WF 0 6.3 6 1,00
Tabelle Februar -> Feb usw.
Danke schon mal für eure Hilfe.
Gruss sas
Antwort 1 von nok106 vom 11.03.2019, 10:03 Options
Hallo sas,
versuche es mal hiermit:
Sub Sicherung_Mappe()
Dim wbThis As Workbook, wbSicherung As Workbook, I As Integer
Dim wksThis As Worksheet, wksSicherung As Worksheet, Bereich As Range, Zelle As Range
Set wbThis = ThisWorkbook
Set wbSicherung = Application.Workbooks.Add(xlWorksheet)
For I = 2 To wbThis.Worksheets.Count
wbSicherung.Worksheets.Add After:=wbSicherung.Sheets(I - 1)
Next
For I = 1 To wbThis.Worksheets.Count
Set wksThis = wbThis.Worksheets(I)
Set wksSicherung = wbSicherung.Worksheets(I)
wksSicherung.Activate
wksSicherung.Name = wksThis.Name
If wksThis.PageSetup.PrintArea = "" Then 'kein Druckbereich festgelegt
Set Bereich = wksThis.UsedRange
Else
Set Bereich = wksThis.Range(wksThis.PageSetup.PrintArea)
End If
'Spaltenbreiten in Sicherung einstellen
For Each Zelle In wksThis.Range(Bereich.Cells(1, 1), Bereich.Cells(1, Bereich.Columns.Count))
wksSicherung.Columns(Zelle.Column - Bereich.Column + 1).ColumnWidth = Zelle.EntireColumn.ColumnWidth
Next
'Formate und Werte kopieren
Bereich.Copy
wksSicherung.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
wksSicherung.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
wksSicherung.Cells(1, 1).Select
Next
wbSicherung.SaveAs "D:\TestName.xls"
wbSicherung.Close
End Sub
Gruß Odje
versuche es mal hiermit:
Sub Sicherung_Mappe()
Dim wbThis As Workbook, wbSicherung As Workbook, I As Integer
Dim wksThis As Worksheet, wksSicherung As Worksheet, Bereich As Range, Zelle As Range
Set wbThis = ThisWorkbook
Set wbSicherung = Application.Workbooks.Add(xlWorksheet)
For I = 2 To wbThis.Worksheets.Count
wbSicherung.Worksheets.Add After:=wbSicherung.Sheets(I - 1)
Next
For I = 1 To wbThis.Worksheets.Count
Set wksThis = wbThis.Worksheets(I)
Set wksSicherung = wbSicherung.Worksheets(I)
wksSicherung.Activate
wksSicherung.Name = wksThis.Name
If wksThis.PageSetup.PrintArea = "" Then 'kein Druckbereich festgelegt
Set Bereich = wksThis.UsedRange
Else
Set Bereich = wksThis.Range(wksThis.PageSetup.PrintArea)
End If
'Spaltenbreiten in Sicherung einstellen
For Each Zelle In wksThis.Range(Bereich.Cells(1, 1), Bereich.Cells(1, Bereich.Columns.Count))
wksSicherung.Columns(Zelle.Column - Bereich.Column + 1).ColumnWidth = Zelle.EntireColumn.ColumnWidth
Next
'Formate und Werte kopieren
Bereich.Copy
wksSicherung.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
wksSicherung.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
wksSicherung.Cells(1, 1).Select
Next
wbSicherung.SaveAs "D:\TestName.xls"
wbSicherung.Close
End Sub
Gruß Odje
Antwort 2 von sas vom 11.03.2019, 10:14 Options
Hallo Odje,
zuerst einmal danke für deine Mühe.
Leider kann ich den Code nicht in Verbindung mit meinem Problem bringen.
Ich möchte eigentlich meinen oben genannten Code verwenden, nur dass dieser gleichzeitig für alle Tabellen
von Januar bis Dezember durchgeführt wird.
Bisher bekomme ich dies immer nur für eine Tabelle.
Ich müsste diesen also genau 12 mal durchführen und immer aktive Blatt aktivieren (also sehr umständlich).
Mir ist zwar klar, dass dies mit For each ... next funktionieren
sollte, ich weiss aber nicht wie ich dies umsetzen soll.
Gruss sas
zuerst einmal danke für deine Mühe.
Leider kann ich den Code nicht in Verbindung mit meinem Problem bringen.
Ich möchte eigentlich meinen oben genannten Code verwenden, nur dass dieser gleichzeitig für alle Tabellen
von Januar bis Dezember durchgeführt wird.
Bisher bekomme ich dies immer nur für eine Tabelle.
Ich müsste diesen also genau 12 mal durchführen und immer aktive Blatt aktivieren (also sehr umständlich).
Mir ist zwar klar, dass dies mit For each ... next funktionieren
sollte, ich weiss aber nicht wie ich dies umsetzen soll.
Gruss sas
Ähnliche Themen
Daten übertragen
alfaa 25.03.2007 - 95 Hits - 2 Antworten
Alte Daten auf neuen PC übertragen - Wie?
derix 07.01.2008 - 64 Hits - 8 Antworten
Daten aus Tabellen in neue Tabelle
manzur 21.01.2008 - 21 Hits - 8 Antworten
Wie kann ich Daten übertragen?
Nikki-Mausi 29.01.2008 - 112 Hits - 5 Antworten
Hinweis
Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..
Neue Einträge
