Zellen mit Inhalt in Ziel-ws kopieren
10.01.2022 13:17:24
efffff
vorab, ich habe mir den bisherigen Code aus verschiedenen Foren kopiert und umgeschrieben. Außer den "leichten" Dingen kann ich nicht programmieren. Ich möchte gewisse Spalten aus "Tabelle2" in "Tabelle1" ab Zeile 6 kopieren. Die Daten aus Tabelle 2 habe ich mir zuvor aus einem gewissen Dateipfad mit verschiedenen Exporten gezogen.
Spalte A hat immer einen Wert. Jetzt war meine Idee die Zeilen zu zählen und mittels Range pro benötigter Spalte in "Tabelle1" zu kopieren, zum Beispiel: Range("M1" & Range("A1").End(xlDown)).Copy Worksheets("Tabelle1").Range("K7") oder Range("B1" & z).Copy Worksheets("Tabelle1").Range("B7") und Funktion, welche die Zeilen in Spalte "A" zählt. Beide Versuche haben jedoch nicht funktioniert.
Könnt Ihr mir da vielleicht weiterhelfen? Danke euch!
Code:
Function AnzahlZeilen(Blatt As Worksheet) As Long
AnzahlZeilen = WorksheetFunction.CountA(Blatt.Range("A:A"))
End Function
Sub Auswerten()
Dim wb As Workbook
Dim ws As Worksheet
Dim Pfad As String
Dim Datei As String
Dim ErgebnisZeile As Long
Dim ErgebnisSpalte As Long
Dim s As Long
Dim z As Long
Dim i As Integer
Set wb = ThisWorkbook
Set ws = wb.ActiveSheet
Application.ScreenUpdating = False
Set ws = ActiveWorkbook.Sheets.Add
ErgebnisZeile = 1
Pfad = "C:\Users\Name\Dateipfad\"
Datei = Dir(CStr(Pfad & "*.xl*"))
Do While Datei ""
Set wb = Workbooks.Open(Pfad & Datei, False, True)
For z = 7 To wb.Sheets("Startexport_2022").UsedRange.Rows.Count
If Trim(CStr(wb.Sheets("Startexport_2022").Cells(z, 1).Value)) "" Then
For s = 1 To wb.Sheets("Startexport_2022").UsedRange.Columns.Count
ws.Cells(ErgebnisZeile, s).Value = _
wb.Sheets("Startexport_2022").Cells(z, s).Value
Next s
ErgebnisZeile = ErgebnisZeile + 1
'ErgebnisSpalte = ErgebnisSpalte
End If
Next z
wb.Close False 'nicht speichern
'Nächste Datei
Datei = Dir()
Loop
'Variablen aufräumen
'Set ws = Nothing
'Set wb = Nothing
n = AnzahlZeilen(Worksheets("Tabelle2"))
'Kopieren
Worksheets("Tabelle2").Select
'Auftrags-Nr
Range("A1" & z).Copy Worksheets("Tabelle1").Range("D7") 'Idee Nr1
'Prod-Nr
'Range("B1" & z).Copy Worksheets("Tabelle1").Range("B7")
'Fzg-Nr
'Range("C1" & Range("A1").End(xlDown)).Copy Worksheets("Tabelle1").Range("C7") 'Idee Nr2
Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
End Sub