AW: Daten mit vba kopieren
27.10.2009 13:33:28
JogyB
Hi.
Daten aus einer geschlossenen Arbeitsmappe geht prinzipiell, aber nicht bei geschlossener Mappe.
Ok, mal hier der komplette Code, der die Mappe ggf. öffnet, den Autofilter einschaltet, die gefilterten Werte kopiert und in das zweite Arbeitsblatt der Tabelle mit dem Button einfügt.
Private Sub CommandButton1_Click()
Dim myWbk As Workbook
Const myPath = "\\ge.bwfww.de\user\joachim.binnig\dokumente\temp\" '"C:\temp\" ' Pfad der _
Quelldatei
Const myFile = "testmappe.xls" ' Name der Quelldatei
Dim alrOpen As Boolean ' Legt fest, ob Datei schon offen war
' Prüfen, ob Quelldatei schon offen
On Error Resume Next
Set myWbk = Workbooks(myFile)
' Bildschirmupdate aus, sonst flackert es
Application.ScreenUpdating = False
' Wenn noch nicht offen, dann öffen
If myWbk Is Nothing Then
Set myWbk = Workbooks.Open(myPath & myFile)
' Testen, ob es geklappt hat
If myWbk Is Nothing Then
MsgBox ("Kann '" & myFile & "' nicht öffnen!")
Application.ScreenUpdating = True
Exit Sub
End If
' Wenn offen, dann testen, ob es die richtige ist
Else
If Not myWbk.FullName = myPath & myFile Then
MsgBox ("Andere Datei mit Namen '" & myFile & _
"' ist bereits geöffnet. Diese bitte schliessen.")
Application.ScreenUpdating = True
Exit Sub
Else
alrOpen = True
End If
End If
On Error GoTo 0
' Wenn es hierhin kommt, dann ist die Datei offen
With myWbk.Sheets(1)
' Zuerst mal alles wieder einblenden
If .FilterMode Then .ShowAllData
' Filtert Spalte A nach "a"
' das mußt Du ensprechend anpassen
' Die Spalte gibst Du über Field an, nicht über die Range
' In dem Range muss nur irgendeine Zelle des Datenbereichs stehen
.Range("A1").AutoFilter Field:=1, Criteria1:="a"
' Zielbereich löschen - löscht alle Inhalte des Zielblattes
' bitte ändern oder Bescheid geben, wenn das unerwünscht ist
ThisWorkbook.Worksheets(2).Cells.ClearContents
' Kopiert die vom Autofilter selektierten Daten inkl. Überschrift
' Mit UsedRange ist es recht einfach, wenn Du nur Daten in dem Sheet stehen hast
' und die komplett kopiert werden
' Wenn da noch Kommentare unter dem Datenbereich stehen oder manche Spalten nicht
' kopiert werden sollen, dann müßte man es anders lösen - bitte Bescheid geben
' Ebenso, wenn die Überschrift weg soll
.UsedRange.SpecialCells(xlCellTypeVisible).Copy
' Fügt die Werte ab in die zweite Tabelle ab A1 transponiert ein
ThisWorkbook.Worksheets(2).Range("A1").PasteSpecial Paste:=xlValues, Transpose:=True
' Ende Kopiermodus
Application.CutCopyMode = False
' Quelldatei wieder zu, wenn sie vorher nicht offen war
If Not alrOpen Then
.Parent.Close False
' Bei mir ist immer die Tabelle aktiv in die kopiert wurde,
' wenn die Quelltabelle erst geladen werden mußte (sollte eigentlich nicht)
' Wenn es beim Button bleiben soll, dann noch das hier
' ggf. natürlich Nummer des Arbeitsblattes anpassen
ThisWorkbook.Worksheets(1).Activate
End If
End With
' Screenupdating wieder ein
Application.ScreenUpdating = True
End Sub
Gruss, Jogy