Kopieren Sie Daten anhand von Kriterien in eine andere Arbeitsmappe. Verwenden Sie dazu For loop - excel, vba, excel-vba

Ich habe diesen Code geschrieben. Was macht dieser Code? Es sucht nach Ja im 1. Spalte und wann Ja gefunden, kopiert es die Werte ab Spalte 2 in dieser Reihe bedeutet Reihe 15 Schritt für Schritt bis Spalte I zu einem anderenworkbook and then Es soll in die nächste Zeile gehen, wo next yes vorhanden ist, bedeutet in meinem Fall seine Zeile 17, aber leider geht es nicht. Da ich die for-Schleife verwendet habe, geht sie nach dem Kopieren der Werte aus Zeile 15 weiter. Ja bedeutet Zeile 17, aber leider nicht.

1. Finde ja. In meinem Fall ist First Yes in Zeile 15.
2. Kopiert den Wert ab der nächsten Spalte in eine andere Arbeitsmappe.
3. Nachdem Sie alle Werte in Zeile 15 eingegeben haben, wird mit "Ja" fortgefahren.
4. Weiter Ja, in meinem Fall steht es in Zeile 17, aber es sollte in einer beliebigen Zeile stehen, deshalb habe ich dafür die For-Schleife verwendet.

Kann mir jemand mitteilen, wo ich falsch liege?

Schauen Sie sich auch das Bild an

   Dim i As Integer
Dim Percent As Variant
Dim Search As String
Dim wkb As Workbook
Dim WrkSht As Worksheet

Search = InputBox("Enter your search word here")
If Search = "" Then Exit Sub
For i = 1 To Range("A65536").Cells.End(xlUp).Row
If Cells(i, 1) = Search Then GoTo Other
Next i
MsgBox "Not avaiable"
Exit Sub
Other:
For i = 1 To Range("A65536").Cells.End(xlUp).Row
If Cells(i, 1) = Search Then

Set wb = Workbooks.Add
ThisWorkbook.Activate
Worksheets("Template").Copy Before:=wb.Sheets(1)
wb.Activate
wb.SaveAs "U:test1.xlsx"

Workbooks("Mappe.xlsm").Worksheets("Sheet1").Activate


Cells(i, 2).Select


Workbooks("Mappe.xlsm").Worksheets("Sheet1").Cells(i, 2).Copy

Workbooks("test1.xlsx").Worksheets("Template").Activate
Cells(16, 3).Select
ActiveSheet.Paste

Workbooks("Mappe.xlsm").Worksheets("Sheet1").Cells(i, 3).Copy
Workbooks("test1.xlsx").Worksheets("Template").Activate
Cells(17, 3).Select
ActiveSheet.Paste

Workbooks("Mappe.xlsm").Worksheets("Sheet1").Cells(i, 4).Copy
Workbooks("test1.xlsx").Worksheets("Template").Activate
Cells(18, 3).Select
ActiveSheet.Paste

Workbooks("Mappe.xlsm").Worksheets("Sheet1").Cells(i, 5).Copy
Workbooks("test1.xlsx").Worksheets("Template").Activate
Cells(19, 3).Select
ActiveSheet.Paste
Workbooks("Mappe.xlsm").Worksheets("Sheet1").Cells(i, 6).Copy
Workbooks("test1.xlsx").Worksheets("Template").Activate
Cells(20, 3).Select
ActiveSheet.Paste
Workbooks("Mappe.xlsm").Worksheets("Sheet1").Cells(i, 7).Copy
Workbooks("test1.xlsx").Worksheets("Template").Activate
Cells(21, 3).Select
ActiveSheet.Paste
Workbooks("Mappe.xlsm").Worksheets("Sheet1").Cells(i, 8).Copy
Workbooks("test1.xlsx").Worksheets("Template").Activate
Cells(22, 3).Select
ActiveSheet.Paste
Workbooks("Mappe.xlsm").Worksheets("Sheet1").Cells(i, 9).Copy
Workbooks("test1.xlsx").Worksheets("Template").Activate
Cells(23, 3).Select
ActiveSheet.Paste

Workbooks("Mappe.xlsm").Worksheets("Sheet1").Cells(i, 2).Copy

Workbooks("test1.xlsx").Worksheets("Template").Activate
Cells(16, 4).Select
ActiveSheet.Paste
Workbooks("Mappe.xlsm").Worksheets("Sheet1").Cells(i, 3).Copy
Workbooks("test1.xlsx").Worksheets("Template").Activate
Cells(17, 4).Select
ActiveSheet.Paste
Workbooks("Mappe.xlsm").Worksheets("Sheet1").Cells(i, 4).Copy
Workbooks("test1.xlsx").Worksheets("Template").Activate
Cells(18, 4).Select
ActiveSheet.Paste
Workbooks("Mappe.xlsm").Worksheets("Sheet1").Cells(i, 5).Copy
Workbooks("test1.xlsx").Worksheets("Template").Activate
Cells(19, 4).Select
ActiveSheet.Paste
Workbooks("Mappe.xlsm").Worksheets("Sheet1").Cells(i, 6).Copy
Workbooks("test1.xlsx").Worksheets("Template").Activate
Cells(20, 4).Select
ActiveSheet.Paste
Workbooks("Mappe.xlsm").Worksheets("Sheet1").Cells(i, 7).Copy
Workbooks("test1.xlsx").Worksheets("Template").Activate
Cells(21, 4).Select
ActiveSheet.Paste
Workbooks("Mappe.xlsm").Worksheets("Sheet1").Cells(i, 8).Copy
Workbooks("test1.xlsx").Worksheets("Template").Activate
Cells(22, 4).Select
ActiveSheet.Paste
Workbooks("Mappe.xlsm").Worksheets("Sheet1").Cells(i, 9).Copy
Workbooks("test1.xlsx").Worksheets("Template").Activate
Cells(23, 4).Select
ActiveSheet.Paste

End If
Next i

Antworten:

Dieses Unterelement sollte die verwendeten Zeilen des aktiven Blatts bestimmen, die verwendeten Zeilen durchlaufen und angeben, ob die erste Spalte einer Zeile vorhanden ist yes dann erstellt es eine neue Arbeitsmappe, kopiert die template aus der aktiven Arbeitsmappe und kopiert Spalte 2 in Spalte I in diese Vorlage (in der neuen Arbeitsmappe). Dann wird die neue Arbeitsmappe gespeichert und geschlossen. Danach geht es in die nächste Reihe.

Dies sollte ein guter Anfang für Sie sein, um selbstständig zu verlängern.

Option Explicit "Forces you to declare every variable

Sub testNew()
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet "better: ThisWorkbook.Worksheets("your-worksheet-name")

Dim NewWb As Workbook

Dim FirstUsedRow As Long, LastUsedRow As Long
FirstUsedRow = ws.UsedRange.Rows(1).Row "find first used row
LastUsedRow = FirstUsedRow + ws.UsedRange.Rows.Count - 1 "find last used row

Dim SearchWord As String
SearchWord = InputBox("Enter your search word here", "Search", "yes")
If SearchWord = "" Then Exit Sub

Application.ScreenUpdating = False "deactivate screen updating (prevents flickering)

Dim i As Long, PasteRow As Long
PasteRow = 1 "start pasting in row 1 of the new sheet
For i = FirstUsedRow To LastUsedRow "loop through all used rows
If ws.Cells(i, 1) = SearchWord Then "if the first column is "yes" then do ...
If NewWb Is Nothing Then
Set NewWb = Application.Workbooks.Add  "create a new workbook if none was created yet
ThisWorkbook.Worksheets("Template").Copy Before:=NewWb.Sheets(1) "copy sheet template into new workbook
ThisWorkbook.Activate
End If

ws.Range(Cells(i, 2), Cells(i, "I")).Copy "copy row i column 2 to column I
NewWb.Worksheets("Template").Cells(PasteRow, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
"---> paste to new workbook sheet template at row PasteRow

PasteRow = PasteRow + 1 "increment to next row
End If
Next i

Application.ScreenUpdating = True "don"t forget to re-activate screen updating

If Not NewWb Is Nothing Then "if search word was found then save workbook
NewWb.Activate
NewWb.SaveAs Filename:="C:Temptest1.xlsx", FileFormat:=xlOpenXMLWorkbook "save workbook
"for FileFormat see: https://msdn.microsoft.com/en-us/library/office/ff198017.aspx
"NewWb.Close "close the workbook (uncomment to close the workbook)
Set NewWb = Nothing "empty variable
Else
MsgBox "Search word "" & SearchWord & "" not found."
End If
End Sub