Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1300to1304
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Alle Zeilen von Tabellenblatt A nach B kopieren

Alle Zeilen von Tabellenblatt A nach B kopieren
25.02.2013 14:41:05
Tabellenblatt
Hallo
ich tue mir wieder mal schwer in Sachen VBA und hoffe, dass mir hier jemand weiterhelfen mag ?
Aus einer Worksheet möchte ich per Makro alle nichtleeren Zeilen komplett in ein anderes Worksheet übertragen und dort am Ende des Worksheets (bei der nächsten freien Zeile) anhängen.
Bestimmt geht sowas ? fragt sich nur wie ?
macht man sowas mit "for each used range in .... ?"
Wäre echt nett, wenn mir jemand dabei auf die richtige Spur helfen könnte.

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
mit Autofilter
25.02.2013 15:13:20
CitizenX
Hi,
Kommentare im Code beachten:

Option Explicit
Sub CopyMe()
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Application.ScreenUpdating = False
Set wks1 = Sheets("Tabelle2") 'Daten Tabelle ,Name anpassen
Set wks2 = Sheets("Tabelle3") 'Ausgabe Tabelle ,Name anpassen
With wks1
'Daten in Spalte "A" ggf anpassen
.Columns("A").AutoFilter Field:=1, Criteria1:=""
' Beginn der Daten in Zelle "A2" ggf anpassen                            Ausgabe in  _
Spalte A
.Range(.Range("A2"), .Range("A2").End(xlDown)).Copy wks2.Cells(wks2.Cells(wks2.Rows. _
Count, 1).End(xlUp).Row + 1, 1)
.AutoFilterMode = False
End With
Application.ScreenUpdating = True
Set wks1 = Nothing
Set wks2 = Nothing
End Sub

Grüße
Steffen

Anzeige
OT: Autofilter im Makro
25.02.2013 15:23:37
Klaus
Hi Steffen,
ich habe immer wieder das Problem, dass meine "dummen User" den Autofilter abschalten, versetzen oder sonstwas damit anstellen und somit den Makrodurchlauf behindern. Schon eine Filterung in einem beliebigem Feld vor Makrostart kann zu falschen Ergebnissen führen! Ich habe mir daher angewöhnt, den Autofilter im Laufe des Makros nochmal definitiv dahin zu setzen wo er hingehört (und alle alten Filterungen zu verwerfen). Code anbei:
Option Explicit
Sub CopyMe()
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Application.ScreenUpdating = False
Set wks1 = Sheets("Tabelle2") 'Daten Tabelle ,Name anpassen
Set wks2 = Sheets("Tabelle3") 'Ausgabe Tabelle ,Name anpassen
With wks1
'Autofilter zurücksetzen
Call DoResetAutofilter(wks1, 1, 1, 1)
'setze Autofilter auf: wks1 / ab Spalte 1 / bis Spalte 1 / ab Zeile 2
'eventuell anpassen
'Daten in Spalte "A" ggf anpassen
.Columns("A").AutoFilter Field:=1, Criteria1:=""
' Beginn der Daten in Zelle "A2" ggf anpassen                            Ausgabe in _
Spalte A
.Range(.Range("A2"), .Range("A2").End(xlDown)).Copy wks2.Cells(wks2.Cells(wks2.Rows. _
Count, 1).End(xlUp).Row + 1, 1)
.AutoFilterMode = False
End With
Application.ScreenUpdating = True
Set wks1 = Nothing
Set wks2 = Nothing
End Sub
Sub DoResetAutofilter(wksMySheet As Worksheet, iColFirst As Integer, iColLast As Integer,  _
lRowFirst As Long)
'* in case a user used another autofiler, this makro resets the autofilter to where needed.
Dim lRowLast As Long
With wksMySheet
lRowLast = .Cells(.Rows.Count, iColFirst).End(xlUp).Row
If .AutoFilterMode Then .Cells.AutoFilter 'Turns OFF Autofilter, if any
.Range(.Cells(lRowFirst, iColFirst), .Cells(lRowLast, iColLast)).AutoFilter 'Turns ON  _
Autofilter on given range
End With
End Sub
Schadet nicht, hilf manchmal und dauert nur eine zehntel Sekunde.
Grüße,
Klaus M.vdT.

Anzeige
AW: mit Autofilter
25.02.2013 15:26:53
Natacha
Hi alle zusammen,
jezt bin ich aber echt überwältigt von der raschen und supernetten Hilfe hier. Vielen Dank schon mal Euch allen !
Ich hab nun mal die Lösung von Steffen gewählt und ausprobiert. Dieser Code macht eigentlich das Richtige, allerdings wird nur die Spalte A kopiert.
Es müsste aber die komplette Zeile in die Zieltabelle kopiert werden.
kann ich das irgendwo entsprechend anpassen ?
Greets:
Natacha

AW: mit Autofilter
25.02.2013 15:28:40
Klaus
Hi,
tausche diese Zeile
        .Range(.Range("A2"), .Range("A2").End(xlDown)).Copy wks2.Cells(wks2.Cells(wks2.Rows.Count, 1).End(xlUp).Row + 1, 1)

gegen diese
        .Range(.Range("A2"), .Range("A2").End(xlDown)).entirerow.Copy wks2.Cells(wks2.Cells(wks2.Rows. Count, 1).End(xlUp).Row + 1, 1)

dann sollte es die ganze Zeile mitnehmen.
Grüße,
Klaus M.vdT.

Anzeige
AW: mit Autofilter
25.02.2013 15:33:27
Natacha
Hallo Klaus,
Klasse !
vielen Dank. Gruss: Natacha

Danke für die Rückmeldung! mit Text
25.02.2013 15:34:59
Klaus
Hallo Natascha,
gern geschehen! Schau dir doch auch noch meinen OT-Kommentar über den Autofilter an.
Grüße,
Klaus M.vdT.

AW: Alle Zeilen von Tabellenblatt A nach B kopieren
25.02.2013 15:14:03
Tabellenblatt
Hallo Natascha,
mal aus dem Handgelenk, muss bestimmt angepasst werden:
Option Explicit
Sub VonAnachB()
Dim lRowFirst As Long
Dim lRow As Long
Dim lRow2 As Long
Dim iCol As Integer
'in dieser SPALTE die letzte Zeile ermitteln (A=1)
iCol = 1
'AB dieser ZEILE kopieren (in Zeile 1 stehen warscheinlich Überschriften?)
lRowFirst = 2
With ActiveSheet
lRow = .Cells(.Rows.Count, iCol).End(xlUp).Row
.Range(.Cells(lRowFirst, 1), .Cells(lRow, 1)).Copy
End With
Call FileCheckOpen("C:\TestTMP", "Dateiname.xlsx") 'anpassen!
Sheets("Tabelle1").Activate 'anpassen!
With ActiveSheet
lRow2 = .Cells(.Rows.Count, iCol).End(xlUp).Row + 1
'Einfügen mit Formeln, Formatierungen und Rahmen usw.
.Cells(lRow2, 1).PasteSpecial
'Nur Werte einfugen.
'.Cells(lRow2, 1).PasteSpecial xlPasteValues
End With
End Sub
'*********************************************************************************************** _
'* Module to open needed files. Checks if Files are open or not.
'* If file is already open, do nothing - else open it
'* stolen from: https://www.herber.de/mailing/Pruefen_ob_Arbeitsmappe_geoeffnet_und_wenn_nein_oeffnen.htm
'* modified by Klaus M.vdT. / 16.NOV.2012
'*********************************************************************************************** _
'Example:
'Call FileCheckOpen("C:\TMP", "Filename.xls")
'path and filename can be RANGE from excelsheet
Sub FileCheckOpen(sPath As String, sFile As String)
sPath = sPath & "/" & sFile
If WkbExists(sFile) = False Then
If Dir(sPath) = "" Then
MsgBox "File " & sPath & " not found!"
Else
Workbooks.Open sPath, UpdateLinks:=False
End If
Else
Workbooks(sFile).Activate
End If
End Sub
Grüße,
Klaus M.vdT.

Anzeige
Nimm CitizenX Version!
25.02.2013 15:16:39
Klaus
Hi,
du hattest "Worksheet" geschrieben, ich habe aber "Workbook" gedacht. Damit ist mein Code hinfällig.
Grüße,
Klaus M.vdT.

AW: Alle Zeilen von Tabellenblatt A nach B kopieren
25.02.2013 15:15:57
Tabellenblatt
Hallo Natacha,
zunächst Quell-Bereich und erste Zeile des Zielbereichs bestimmen.
Quell-Bereich könnte UsedRange sein, Überschriften solen aber ausgenommen werden. z.B.
with Quelltab
Set Quellbereich = .Range(.Cells(3,1),.Cells(.UsedRange.row+.UsedRange.rows.Count,1))
end with
with Zieltab
ZielZeile= Range("A" & .rows.count).End(xlup).Row + 1
end with
Dann kann für jede Quellzelle (der Quellbereich ist deshalb nur eine Spalte breit)
die Zeile kopiert werden, falls die Zelle nicht leer ist
for each zellchen in Quellbereich.cells
if zellchen.text "" then
zellchen.entirerow.copy zieltab.range("A"&ZielZeile)
ZielZeile=Zielzeile+1
endif
next zellchen
Der Code hat vermutlich ein paar Syntaxfehler und braucht auch noch DIM-Befehle usw.
aber Du wolltest ja auch nur die richtige Spur,
oder?
Herzliche Grüße,
Günther
Anzeige

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige