vba aus einer .xls alle tabellen zu einer machen
06.05.2015 00:16:00
Ruth
ich habe mein erstes Makro geschrieben.
Nun würde ich mich über Hilfe freuen, was ich besser machen kann.
-ich habe ein .xls(Nr1) mit unterschiedlich vielen Tabellen (der Dateiname ändert sich jeden Monat, die Tabellennamen jede Woche
-Aufgabe:aus einem weiteren .xls(Nr2) (mit Schaltfläche).xls(Nr1) erfragen, öffnen,
und alle Daten ab Zeile 3 in .xls(Nr2) kopieren.
-der Bereich mit dem einfügen, macht mir Probleme, es kostet soviele "Durchläufe" auf eine leere Zeile zu kommen, um alle Daten in eine Tabelle zu kopieren.
-wie kann ich einen schönen Abschluss finden. z.B. msgbox"es gibt keine weiteren Daten zum kopieren", die MsgBox krieg ich hin, aber woher weiss das Makro, dass nun schluss ist?
-kann ich bei der schleife mit den tabellen auch mit "worksheets.count" arbeiten? ist mir noch nicht gelungen, immer taucht ein fehler auf.
Vielen Dank
Ruth
Public Sub mdlChecklisteCopyPaste()
Dim awb As Workbook 'aktives worksheet - soll sich auf die Tabelle beziehen / mit set _
zugewiesen
Dim sheet1 As Worksheets
'Dim i As Integer 'Zähler für Tabellen-Durchlauf
Dim d As String 'dateiname für Tabelle 'zugewiesen
Dim dn As String 'dateiname d+s 'zugewiesen
Dim s As String 'variable für das zuzugreifende xls 'zugewiesen
Dim f As Integer 'Zähler für Schleife
Dim u As Integer 'zum durchzählen der Tabellen 'zugewiesen
s = InputBox("Bitte geben Sie den Namen der Checkliste ein:", "Anfrage Checkliste", "2015 _
Januar.xls")
'Fragebox um die richtige Tabelle aufzurufen
Const pfad As String = ("C:\Users\Mummy\Documents\Test Check\")
'Konstanter Pfad, um die Checkliste zu öffnen
d = pfad
dn = d & s 'konstanter Pfad + variabeler Tabellenname
ChDir "C:\Users\Mummy\Documents\Test Check\" 'gehe zum pfad "d"
Workbooks.Open Filename:=dn 'öffne das file mit dem namen: dn
Set awb = ActiveWorkbook 'zuweisung variable awb zu der sich öffnenden Tabelle
'Selection.AutoFilter 'ticke den autofilter an
ActiveSheet.Rows("2").Copy 'ort: Tabelle / Zeile 2 / kopieren
Windows("CheckLK.xlsm").Activate 'gehe zu dem xls sheet, in dem reinkopiert werden soll
Sheets(2).Select
Rows("1:1").Select 'gehe zu Zeile 1
ActiveSheet.Paste 'füge die headline ein
Application.CutCopyMode = False 'sorgt dafür, dass der KopierRahmen verschwindet
awb.Activate 'gehe zu dem worksheet, das dem namen awb zugewiesen _
wurde
'ActiveWorkbook.Worksheets.Count 'zählt die worksheets durch
For u = 1 To 5 Step 1
Sheets(u).Select 'wähle sheet 1, dann zwei, dann 3 etc
Range(Range("A3"), Range("A3").End(xlDown)).EntireRow.Select 'wähle zeile, nun nach _
unten bis ende text
Selection.Copy 'kopiere das ausgewä _
hlte
Windows("CheckLK.xlsm").Activate 'gehe zu dieser Seite
Sheets(2).Select
Range("a2").Select 'wähle zeile A2
For f = 1 To 5000 'gehe von zeile zu zeile
If ActiveCell.Value "" Then ActiveCell.Offset(1, 0).Select Else Exit For
'falls zeile voll, gehe zur nächsten zeile
Next f
ActiveSheet.Paste 'füge die werte ein
Application.CutCopyMode = False 'sorgt dafür, dass der Kopierrahmen _
verschwindet
awb.Activate
Next u
Application.CutCopyMode = False
End Sub