AW: aufgezeichnetes Makro führt nur teilweise aus
02.03.2018 22:52:13
Dieter
Hallo Emma,
da hast du dir ja als Anfängerin etwas vorgenommen. Mit der Makroausführung kommst du da nicht weit. Bei jeder Zeileneinfügung verschieben sich ja die Nummern der Zeilen hinter der eingefügten Zeile.
Um die Sache mehrfach laufen zu lassen, musst du schon nach festen Schlüsselbegriffen suchen und dann die Zeileneinfügungen an den gefundenen Zeilennummern ausrichten.
Ich habe dir das mal für die ersten beiden Blätter programmiert. Für das Blatt "Rechnungen" sollte es analog gehen.
Sub Ausgangsdaten()
Dim strABN As String ' Artikelnummer, Baumuster und Nummer
Dim strCOO As String ' Country of Origin ...
Dim strTNP As String ' Total net price
Dim wb As Workbook
Dim wsA As Worksheet
Dim wsR As Worksheet
Dim wsZ As Worksheet
Dim zeileABN As Long
Dim zeileABN_Ziel As Long
Dim zeileCOO As Long
Dim zeileCOO_Ziel As Long
Dim zeileGewicht_Anf As Long
Dim zeileGewicht_End As Long
Dim zeileTNP As Long
Set wb = ThisWorkbook
Set wsA = wb.Worksheets("Ausgangsdaten")
Set wsR = wb.Worksheets("Rechnung")
Set wsZ = wb.Worksheets("Zollrechnung")
strTNP = "Total net price"
strABN = "Artikelnummer" & vbLf & "Baumuster und Nummer"
strCOO = "Country of Origin: Federal Republic of Germany (European Union)"
' Bearbeitung von Blatt "Ausgangsdaten"
zeileTNP = ZeilenNummer(Blatt:=wsA, _
Spalte:=3, _
Text:=strTNP)
If zeileTNP = 0 Then
Exit Sub
End If
wsA.Rows(zeileTNP - 3).Resize(2).Copy
wsA.Rows(zeileTNP - 1).Insert
Application.CutCopyMode = xlCut
zeileABN = ZeilenNummer(Blatt:=wsA, _
Spalte:=2, _
Text:=strABN)
If zeileABN = 0 Then
Exit Sub
End If
zeileABN_Ziel = zeileABN
Do Until IsEmpty(wsA.Cells(zeileABN_Ziel, "B"))
zeileABN_Ziel = zeileABN_Ziel + 1
Loop
wsA.Rows(zeileABN).Copy Destination:=wsA.Rows(zeileABN_Ziel)
' Bearbeitung von Blatt "Zollrechnung"
zeileTNP = ZeilenNummer(Blatt:=wsZ, _
Spalte:=2, _
Text:=strTNP)
If zeileTNP = 0 Then
Exit Sub
End If
wsZ.Rows(zeileTNP - 3).Resize(2).Copy
wsZ.Rows(zeileTNP - 1).Insert
Application.CutCopyMode = xlCut
zeileCOO = ZeilenNummer(Blatt:=wsZ, _
Spalte:=2, _
Text:=strCOO)
If zeileCOO = 0 Then
Exit Sub
End If
zeileCOO_Ziel = zeileCOO
Do Until IsEmpty(wsZ.Cells(zeileCOO_Ziel, "B"))
zeileCOO_Ziel = zeileCOO_Ziel + 1
Loop
wsZ.Rows(zeileCOO + 1).Resize(2).Copy
wsZ.Rows(zeileCOO_Ziel).Insert
Application.CutCopyMode = xlCut
zeileGewicht_Anf = zeileCOO_Ziel + 3
' Zeilenblock mit den Angaben zu Gewicht und Maß bestimmen
Do Until Not IsEmpty(wsZ.Cells(zeileGewicht_Anf, "B"))
zeileGewicht_Anf = zeileGewicht_Anf + 1
Loop
zeileGewicht_End = zeileGewicht_Anf + 1
Do Until IsEmpty(wsZ.Cells(zeileGewicht_End, "B"))
zeileGewicht_End = zeileGewicht_End + 1
Loop
wsZ.Rows(zeileGewicht_Anf).Resize(2).Copy
wsZ.Rows(zeileGewicht_End).Insert
Application.CutCopyMode = xlCut
End Sub
Function ZeilenNummer(Blatt As Worksheet, Spalte As Long, Text As String) As Long
Dim suchErgebnis As Object
Set suchErgebnis = Blatt.Columns(Spalte).Find(What:=Text, _
LookIn:=xlValues)
If Not suchErgebnis Is Nothing Then
ZeilenNummer = suchErgebnis.Row
Else
MsgBox "Text """ & Text & """" & vbNewLine & "in Spalte " & Spalte & _
" vom Blatt """ & Blatt.Name & """ nicht vorhanden"
End If
End Function
https://www.herber.de/bbs/user/120176.xlsm
Mit freundlichen Grüßen
Dieter