Office: Letzte beschriftete Zeile erkennen und in nächste einfügen

Hallo liebe Leute,
ich habe da ein kleines Problem.
Und zwar habe ich einen VBA-Code, der Dateien öffnet und bestimmte Spalten in ein neues Excel-Sheet kopiert.
Die kopierten Spalten werden in dem neuen Sheet untereinander angeordnet.

Nun zu meiner Frage:
wie schaffe ich es, dass vor dem Einfügen der nächsten Spalte die letzte beschriftete Zeile erkannt wird?Ich möchte erreichen, dass dann in der nächsten Zeile eingefügt wird.

In meinem Beispiel funktioniert dies auch, jedoch habe ich den Bereich händisch über range angegeben, was ich möglichst verhindern möchte.

Anbei der Code:

Code:

Private Sub CommandButton1_Click()
Call Wertekopieren
Call Wertekopieren1
End Sub

Public Sub Wertekopieren()
Application.ScreenUpdating = False
    Dim wb1 As Workbook
    Dim wb1pfad As String
    Dim wb1name As String
    Dim wb2 As Workbook
    Dim wb2pfad As String
    Dim wb2name As String
    Dim wb1ws1 As Worksheet
    Dim wb2ws1 As Worksheet
    Dim bwbopen As Boolean
   
On Error GoTo Weiter
   
        wb1pfad = "C:\"
        wb1name = "Datei1.xls"
       
        wb2pfad = "C:\"
        wb2name = "DateiNEU.xls"
       
    bwbopen = WorkbookIsOpen(wb1name)
       
            If bwbopen = False Then
                    Workbooks.Open (wb1pfad & wb1name)
                Else
            End If
               
                        Set wb1 = Workbooks(wb1name)
                        Set wb2 = Workbooks(wb2name)
                        Set wb1ws1 = wb1.Worksheets("Daten")     
                        Set wb2ws1 = wb2.Worksheets("Tabelle1")    
       
                            wb1ws1.Range("A6:A2205,F6:F2205").Copy
                            wb2ws1.Range("A2:B2201").PasteSpecial (xlPasteAll)
                            wb2ws1.Range("C2:C2201") = "26.04.2011"
                            Application.CutCopyMode = False
            If bwbopen = False Then
                        wb1.Activate
                    ActiveWorkbook.Close
                Else
            End If
               
                            Range("A").Select

Weiter:

On Error Resume Next

    bwbopen = WorkbookIsOpen(wb1name)
        If bwbopen = True Then
                wb1.Activate
                ActiveWorkbook.Close
            Else
        End If

Application.ScreenUpdating = False
       
               
End Sub

Function WorkbookIsOpen(WBName As String) As Boolean
        On Error Resume Next
        WorkbookIsOpen = Not Workbooks(WBName) Is Nothing
End Function

Public Sub Wertekopieren1()
Application.ScreenUpdating = False
    Dim wb1 As Workbook
    Dim wb1pfad As String
    Dim wb1name As String
    Dim wb2 As Workbook
    Dim wb2pfad As String
    Dim wb2name As String
    Dim wb1ws1 As Worksheet
    Dim wb2ws1 As Worksheet
    Dim bwbopen As Boolean
   
On Error GoTo Weiter
   
        wb1pfad = "C:\"
        wb1name = "Datei2.xls"
       
        wb2pfad = "C:\"
        wb2name = "DateiNEU"
       
    bwbopen = WorkbookIsOpen(wb1name)
       
            If bwbopen = False Then
                    Workbooks.Open (wb1pfad & wb1name)
                Else
            End If
               
                        Set wb1 = Workbooks(wb1name)
                        Set wb2 = Workbooks(wb2name)
                        Set wb1ws1 = wb1.Worksheets("Daten")    
                        Set wb2ws1 = wb2.Worksheets("Tabelle1")    
       
                            wb1ws1.Range("A6:A2302,F6:F2302").Copy
                            wb2ws1.Range("A2202:B4498").PasteSpecial (xlPasteAll)
                            wb2ws1.Range("C2202:C4498") = "10.05.2011"
                            Application.CutCopyMode = False
                            
            If bwbopen = False Then
                        wb1.Activate
                    ActiveWorkbook.Close
                Else
            End If
               
                            Range("A").Select

Weiter:

On Error Resume Next

    bwbopen = WorkbookIsOpen(wb1name)
        If bwbopen = True Then
                wb1.Activate
                ActiveWorkbook.Close
            Else
        End If

Application.ScreenUpdating = False
       
               
End Sub

Achja, der Code ist sich verbesserbar. Ich bin gerade dabei, Excel zu lernen :roll:

Vielen Dank schonmal!

Grüße

 

MsgBox Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row

Gruß Hajo

 

Danke für die schnelle Antwort, Hajo_Zi.
Gibt es denn die Möglichkeit, den Wert, den die MsgBox ausspuckt, in den Range-Befehl zu übernehmen?
Also dass ich die Zeile ansprechen kann, die mir die Box ausgibt?

 

Du hast einen umfangreichen Code gepostet, da bin ich davon ausgegangen Du kennst Dich mit VBA aus.
Cells(Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row+1,1)= ...

Gruß Hajo

 

Hallo Hajo,

vielen Dank,hat super funktioniert :-)

Hab noch ein weiteres Problemchen.
Ich habe in meinem Excel-Sheet einen dynamischen Bereich (Spalten A-F). Nun würde ich gerne die Spalte G mit einem String-Wert in Form eines Datums mittels einer Eingabemaske füllen.
Wenn der Bereich erweitert wird, sollte man in in die Eingabemaske wieder ein Datum eingeben, welches dann aber nur in den neu angefügten Bereich übernommen wird...

Hast du oder jemand anders dafür eine Idee/Lösung?

Vielen lieben Dank :-)