Excel und VBA: Formeln, Programmierung, Lösungen

StandardModule: Modul1

Sub DatenKopie()
   Dim wks
   Dim iRow As Integer, iRowS As Integer
   Dim sfile As String
   Application.ScreenUpdating = False
   sfile = ThisWorkbook.Path & "\test1.xls"
   If Dir(sfile) = "" Then
      Beep
      MsgBox "Testdatei wurde nicht gefunden!"
      Exit Sub
   End If
   Set wks = ActiveSheet
   Workbooks.Open Filename:=sfile
   Worksheets("175802").Select
   iRowS = wks.Cells(Rows.Count, 1).End(xlUp).Row
   If IsEmpty(Range("A1")) Then
      iRow = 1
   Else
      iRow = wks.Cells(Rows.Count, 1).End(xlUp).Row + 1
   End If
   wks.Rows(iRowS).Copy Rows(iRow)
   ActiveWorkbook.Close savechanges:=True
   Application.ScreenUpdating = False
End Sub

    

Beiträge aus dem Excel-Forum zu den Themen Allgemein und Kopieren