jede 10. Zeile prüfen und einfügen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public Sub Beispiel() Dim lngRow As Long With ThisWorkbook.Worksheets("Aufträge") For lngRow = 2 To .Cells(.Row.Count, 1).End(xlUp).Row Step 10 If IsEmpty(.Cells(lngRow, 1).Value) Then Workbooks(Datei1).Worksheets(1).Range("C15").Copy ThisWorkbook.Worksheets("Aufträge").Cells(lngRow, 1).PasteSpecial xlPasteValues End If Next End With End Sub

Public Sub Beispiel() Dim lngRow As Long With ThisWorkbook.Worksheets("Aufträge") For lngRow = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row Step 10 If IsEmpty(.Cells(lngRow, 1).Value) Then Workbooks(Datei1).Worksheets(1).Range("C15").Copy ThisWorkbook.Worksheets("Aufträge").Cells(lngRow, 1).PasteSpecial xlPasteValues End If Next End With End Sub

Nein, das ist ein neu angefügtes Tabellenblatt ohne jegliche Formeln oder sonstigem.

Sub Import_Bestellformular()
Dim strFile As String
Dim strPath As String
Dim strExt As String
Dim ZWB As Workbook
strPath = "C:\Users\Obanslo\Desktop\Sarah\Arbeitsordner\"
strExt = "*.xlsx"
strFile = Dir(strPath & strExt)
Set ZWB = ThisWorkbook
If strPath = "" Then
Exit Sub
Else
Do While Len(strFile) > 0
Workbooks.Open Filename:=strPath & strFile
'--------------------------------------------------------- ab hier
Dim lngRow As Long
With ZWB.Worksheets("Aufträge")
For lngRow = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row Step 10
If IsEmpty(.Cells(lngRow, 1).Value) Then
Workbooks(Datei1).Worksheets(1).Range("C15").Copy
ZWB.Worksheets("Aufträge").Cells(lngRow, 1).PasteSpecial xlPasteValues
End If
Next
End With
Workbooks(strFile).Close savechanges:=False
strFile = Dir()                 ' nächste Datei
Loop
End If
End Sub

Vielleicht hilft es ja wenn ich mal den ganzen code zeige.
Die Idee dahinter ist einfach, dass das makro jede Datei in einem Ordner durcharbeiten soll und dann die werte aus C15 immer in die 10. leere Zeile in das Tabellenblatt "Aufträge" fortführt.
es gibt "leider" keine Fehlermeldung aus, aber das kopieren und einfügen hat wohl auch nicht geklappt. Hab ich da noch nen denkfehler im code oder an was könnte es liegen?
wenn ich ganz normal kopiere ohne diese schleife mit jeder 10. Zeile, klappt das hervorragend.
Also dürfte es da auch kein Fehler mit den datei namen oder dem pfad geben.

Hallo Sarah,
dann teste mal so:

Public Sub Import_Bestellformular()

    Dim strFile As String
    Dim strPath As String
    Dim strExt As String
    Dim ZWB As Workbook
    Dim lngRow As Long

    strPath = "C:\Users\Obanslo\Desktop\Sarah\Arbeitsordner\"
    strExt = "*.xlsx"

    If strPath = "" Then Exit Sub

    strFile = Dir$(strPath & strExt)

    Do Until strFile = vbNullString

        Set ZWB = Workbooks.Open(Filename:=strPath & strFile)
        '--------------------------------------------------------- ab hier

        With ThisWorkbook.Worksheets("Aufträge")
            For lngRow = 2 To .Rows.Count Step 10
                If IsEmpty(.Cells(lngRow, 1).Value) Then
                    .Cells(lngRow, 1).Value = ZWB.Worksheets(1).Range("C15").Value
                    Exit For
                End If
            Next
        End With
        '---------------------------------------------------------
        ZWB.Close SaveChanges:=False

        strFile = Dir$ ' nächste Datei

    Loop
    Set ZWB = Nothing
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

jede 10. Zeile prüfen und einfügen

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

jede 10. Zeile prüfen und einfügen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread