Herbers Excel-Forum - das Archiv
Makro Tabelle kopieren

|
Betrifft: Makro Tabelle kopieren
von: junny
Geschrieben am: 30.10.2003 15:43:00
Hallo Leute,
ich hab da ein makro, welches mir einen speziellen Ordner anzeigt, darau kann ich Dateien einfügen.
Es werden alle Sheets einkopiert und zwar vor die anderen der aktuellen Mappe.
Fragen:
Was muss ich ändern wenn ich die ertse Tabelle nicht will (erst ab der zweiten anfangen zu kopieren)
Was muss ich machen wenn ich die Tabellen nicht vor die anderen der aktuellen Mappe sondern nach der ersten stellen will (zweite, dritte,.. TAbelle der aktuellen Mappe)
Hoffe es ist klar, Danke schon mal
volker
Betrifft: AW: Makro Tabelle kopieren
von: Willie
Geschrieben am: 30.10.2003 16:43:10
Hier dein Retter in der Not..
Gruß Willie aus BaWü
Sub volker()
Dim Blatt As Object
Dim x As Variant
x = 0
For Each Blatt In ThisWorkbook.Sheets
x = x + 1
Next
MsgBox x
Sheets(1).Select
Sheets.Add
Sheets(1).Move After:=Sheets(x + 1)
End Sub
Betrifft: AW: Makro Tabelle kopieren
von: junny
Geschrieben am: 30.10.2003 17:29:46
Hai Willie
eigentlich ist es fast peinlich Dich nochmals an "Deinem" makro rumbasteln zu lassen. Damals waren noch 1 -2 Dinge, nun lauft es aber.
Ich stupfe diese makro mit einem anderen noch zusammen, hier drin will ich die sheets ab Tabelle 2 hinter Tabelle 1 im aktuellen sheet einfügen.
Hier nochmal das makro wie es jetzt ist.
Sub junny()
wert = 1
Dim datei As String
Dim Blatt As Object
Dim x As Variant
x = 0
Application.DisplayAlerts = False
'ChDir "C:\Dokumente und Einstellungen\vw\Eigene Dateien\Test\Zeitenliste" 67
ChDir "C:\Dokumente und Einstellungen\v.weil\Eigene Dateien\Excels\Zeitenliste"
ZuÖffnendeDatei = Application.GetOpenFilename("Textdateien (*.xls), *.xls")
If ZuÖffnendeDatei <> False Then
Workbooks.Open Filename:=ZuÖffnendeDatei
datei = Mid(ZuÖffnendeDatei, 73) 'hier abzählen vonlinks Pfad:
'Bei mir C:\test\ das sind 8 plus 1 = 9
End If
'Application.Wait (Now + TimeValue("0:00:01"))
For i = 1 To 2
ThisWorkbook.Sheets(i).Activate
Sheets.Add
Sheets(i).Move After:=Sheets(x + 1)
Workbooks(datei).Activate
ActiveWorkbook.Sheets(i).Activate
Sheets(i).Cells.Select
'Sheets(1).Select
Selection.Copy
ThisWorkbook.Sheets(i).Activate
'Cells.Select
ActiveSheet.Paste
Sheets(wert).Name = datei & i
Next
Workbooks(datei).Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
Viele Grüsse ebenfalls aus BaWü (FDS)
volker
Betrifft: AW: Makro Tabelle kopieren
von: Willie
Geschrieben am: 30.10.2003 18:03:02
Hallo Volker
Immer Schritt für Schritt durch gehen! F8 !!!!
Du bringst die Blätter glaube ich einweing durcheinander!
du mußt immer eine Variablen prüfen, ob der richtige wert in der
Richtigen Variable ist!
ThisWorkbook.Sheets(x+1).Activate ' Ich denke hier muß nicht i sondern x + 1 stehen!!
'Cells.Select
ActiveSheet.Paste
Sheets(wert).Name = datei & i
Next
Workbooks(datei).Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
Also viel Spass noch beim Testen! Ich bin erst morgen wieder da!
Willie
Betrifft: AW: Makro Tabelle kopieren
von: junny
Geschrieben am: 31.10.2003 10:57:02
Hai Willie,
habe nun zum testen mal meinen Bildschirm geteilt und kräftig mit F8 rummgemacht, jedoch: Mein nbeues Tabellenblatt wird nun an 2. Stelle gesetzt (wie ich es haben will) gehe ich dann mit F8 weiter, (Workbooks(datei).Activate) wird das Blatt von Position 2 an Position 1 verschoben!?!?
Ich habe die vorige Zeile mal so geschrieben(Sheets(i).Move After:=Sheets(2)
) sprich nicht variabel, dann bleibt das Blatt da wo es ist. (aber dann werden ja weitere Blätter immer an die selbe stelle gesetzt, was ja nicht so toll ist!
Weißt Du noch was??
Gruss volker
Sub junny()
wert = 1
Dim datei As String
Dim Blatt As Object
Dim x As Variant
x = 1
Application.DisplayAlerts = False
'ChDir "C:\Dokumente und Einstellungen\vw\Eigene Dateien\Test\Zeitenliste" 67
ChDir "C:\Dokumente und Einstellungen\v.weil\Eigene Dateien\Excels\Zeitenliste"
ZuÖffnendeDatei = Application.GetOpenFilename("Textdateien (*.xls), *.xls")
If ZuÖffnendeDatei <> False Then
Workbooks.Open Filename:=ZuÖffnendeDatei
datei = Mid(ZuÖffnendeDatei, 73) 'hier abzählen vonlinks Pfad:
'Bei mir C:\test\ das sind 8 plus 1 = 9
End If
For i = 1 To 2
ThisWorkbook.Sheets(x + i).Activate
Sheets.Add
Sheets(i).Move After:=Sheets(x + i)
'Application.Wait (Now + TimeValue("0:00:00"))
Workbooks(datei).Activate
ActiveWorkbook.Sheets(i).Activate
Sheets(i).Cells.Select
'Sheets(1).Select
Selection.Copy
ThisWorkbook.Sheets(x + i).Activate
'Cells.Select
ActiveSheet.Paste
Sheets(x + i).Name = datei & i
Next
Workbooks(datei).Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub

 |
Betrifft: AW: Makro Tabelle kopieren
von: Willie
Geschrieben am: 31.10.2003 11:32:02
Du mußt schauen, wo es steht!
ich denke du kannst dann das move vergessen oder eine 1 eintragen!
Mehr fällt mir jetzt auch nicht ein und auf!
Gruß
Willie
Betrifft: Willie es passt
von: junny
Geschrieben am: 31.10.2003 12:20:46
Hai Willie,
habe nun mal sämtliche Einfügedaten mit x + 1 geschrieben, nun werden sämtliche Tabellen immer an Stelle von Tabelle 2 gesetzt und benannt.
So ist das O.K.
DANKE für die Hilfe (nun habe ich das mit der F8 Taste so kapiert das ich es auch sinnvoll anwenden kann)
Gruss volker