Makro zum Kopieren / Einfügen bestimmter Spalten einer Zeile in ein neues Arbeitsblatt, abhängig von den Kriterien

Dies ist mein erster Beitrag, bitte nehmen Sie ihn mit.

Ich verwende einen Code ( von dieser Site ), der eine Liste in der Spalte A eines bestimmten Arbeitsblatts ansieht und aus dieser Liste neue Arbeitsblätter erstellt / benennt (sofern diese noch nicht vorhanden sind). Außerdem werden die Daten aus den Zeilen mit den übereinstimmenden Namen in die entsprechenden Blätter kopiert.

Ich frage mich, wie ich den Code so ändern kann, dass nicht die gesamte Zeile in das neue Blatt kopiert wird, sondern nur Spalten A:P. Ich würde mich über jede Hilfe sehr freuen. Hier ist der Code:

Sub yearAssign()
    Application.ScreenUpdating = False
    On Error GoTo SheetError
    sheetname = "initial"
    Dim wkb As Workbook
    Dim wks As Worksheet
    Dim wks1 As Worksheet
    Set wkb = ThisWorkbook
    Set wks = Sheets(sheetname)
    totalsheets = wkb.Worksheets.Count
    For i = 1 To totalsheets
        Set wks1 = wkb.Worksheets(i)
        thename = wks1.Name
        If thename <> sheetname Then
            wks1.Rows.Clear
        End If
    Next i
    totalrows = wks.Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To totalrows
        theyear = wks.Cells(i, 1)
        Set wks1 = Sheets(theyear)
        lastrow = wks1.Cells(Rows.Count, "A").End(xlUp).Row + 1
        If lastrow = 2 Then
            wks.Rows(1).Copy Destination:=Sheets(theyear).Range("A1")
        End If
        wks.Rows(i).Copy Destination:=Sheets(theyear).Range("A" & lastrow)
    Next i
    Application.ScreenUpdating = True
    finish = MsgBox("Finished", vbInformation)

    SheetError:
    If Err.Number = 9 Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = theyear
        Resume
    End If
End Sub

Die Zeilen, die das eigentliche Kopieren ganzer Zeilen ausführen, sind folgende:

wks.Rows(1).Copy Destination:=Sheets(theyear).Range("A1")

wks.Rows(i).Copy Destination:=Sheets(theyear).Range("A" & lastrow)

Wenn Sie sie also wie folgt ändern, werden nur Spalten kopiert A:P:

wks.Range("A1:P1").Copy Destination:=Sheets(theyear).Range("A1")

wks.Range("A" & i & ":" & "P" & i).Copy Destination:=Sheets(theyear).Range("A" & lastrow)

Der Code weist auch mehrere andere Probleme auf, einschließlich, aber nicht notwendigerweise, der folgenden:

1) Viele Variablendeklarationen fehlen:

Dim sheetname As String
Dim totalsheets As String
Dim theyear As String
Dim thename As String
Dim i As Integer
Dim finish As Integer
Dim totalrows As Long
Dim lastrow As Long

2) sheetnamewird gesetzt, bevor Variablen deklariert werden

3) Es sollte eine generische Fehlerbehandlungsroutine vorhanden sein, Application.ScreenUpdatingdie auf gesetzt werden sollte, True wenn ein Fehler auftritt. Andernfalls Application.ScreenUpdatingbleibt Falsedie Prozedur bestehen, wenn der Fehler behoben ist.

4) Die Vorkommen Sheets(theyear)in den Zeilen, die das Kopieren durchführen, sollten durch ersetzt werden wks1, da die wks1Variable bereits auf gesetzt wurdeSheets(theyear)

Bitte beachten Sie, dass die Angabe Option Explicitoben im Modul dazu beiträgt, die Aufmerksamkeit auf Probleme wie # 1 und # 2 zu lenken, da der Code erst kompiliert wird, wenn die Probleme behoben sind.