In due nächste leere Zeile springen

[Nilsundso]

Hallo Zusammen, 
ich habe folgendes Problem. Ich möchte gerne Daten von einer Excel-Mappe in eine geschlossene Excel-Mappe per Button verschieben. 
Das funktioniert auch alles mehr als nur gut. Problem an der Sache ist, dass es in die nächste leere Zeile geschrieben werden soll und nicht einfach überschrieben. 
Kann man das irgendwie realisieren? 

hier mein Code: 

Public Sub Schreiben()

Dim sPfad        As String
Dim sDatei        As String
Dim WkSh_Q        As Worksheet
Dim WkSh_Z        As Worksheet

  sPfad = "leider zensieren"
  sDatei = "leider zenisieren"
 
  Application.ScreenUpdating = False
 
  If Dir(sPfad & sDatei) <> "" Then
      Workbooks.Open (sPfad & sDatei)
      ThisWorkbook.Activate
      'Application.ActiveWindow.Visible = False
    Else
      MsgBox "Den angegebenen Ordner """ & sPfad & """" & Chr(10) & _
        "und/oder die gesuchte Datei """ & sDatei & """ gibt es nicht!", _
        16, "  Hinweis für " & Application.UserName
      Exit Sub
  End If
   
  Set WkSh_Q = ThisWorkbook.Worksheets("Zeitnachweis")
  Set WkSh_Z = Workbooks(sDatei).Worksheets("Datenbank")
 
  WkSh_Q.Cells.Range("A:G").Copy Destination:=WkSh_Z.Range("A:G")
       
  'last = WkSh_Z.Cells(1, Columns.Count).End(xlUp).Column + 1
  'Cells(last, 1).Value = "Neu"
 
  Workbooks(sDatei).Close SaveChanges:=True
 
  Application.ScreenUpdating = True
 
  MsgBox "Die Daten wurden erfolgreich übergeben.", _
    64, "  Information für " & Application.UserName


End Sub

[schauan]

Hallöchen,

schaue da mal rein
Makro-mit-while

[Gast 123]

Hallo

deine Angaben sind mir im Augenblick zu ungenau. Du sprichst von Zeilen, in nächste leere Zeile kopieren, kopierst aber ganze Spalten!!  Von A-G komplett.
Willst du die Spalten A-G immer komplett kopieren, und in der Zielmappe in die nächste freie Spalte kopieren?  Oder wirklich nur die belegten Zeilen in A-G??
Dann müsstest du vor dem kopieren sowohl in der Queldateil wie auch in der Zieldatei die LastZelle ermitteln.  In der Zieldatei dann LastZelle +1

'last = WkSh_Z.Cells(1, Columns.Count).End(xlUp).Column + 1
Dieser Codeteil kann nicht funktionieren, den xlDown und xlUp bezieht sich nur auf die Zeilen, nicht auf Spalten!!
Für Spalten gilt:  End(xlToLeft).Column  oder End(xlToRight).Column

Bevor wir deinen Code verbessern können müssten wir zuerst konkret wissen was du wirklich kopieren willst???

mfg Gast 123

[EarlFred]

Ich nehme an, die willst in die nächste freie Zelle in Spaltenrichtung schreiben:

Code:

Option Explicit

Public Sub Schreiben()

Dim sPfad            As String:     sPfad = "leider zensieren"
Dim sDatei           As String:     sDatei = "leider zenisieren"
Dim WkSh_Q           As Worksheet
Dim WkSh_Z           As Worksheet
Dim wb_Z             As Workbook
Dim ErsteLeereSpalte As Long

   Application.ScreenUpdating = False
   
   If Dir(sPfad & sDatei) <> "" Then
      Set wb_Z = Workbooks(sDatei)
   Else
      Call MsgBox(Prompt:="Den angegebenen Ordner """ & sPfad & """" & Chr(10) & "und/oder die gesuchte Datei """ & sDatei & """ gibt es nicht!", _
                  Buttons:=vbInformation, _
                  Title:="  Hinweis für " & Application.UserName)
      Exit Sub
   End If
     
   Set WkSh_Q = ThisWorkbook.Worksheets("Zeitnachweis")
   Set WkSh_Z = wb_Z.Worksheets("Datenbank")
  
   ErsteLeereSpalte = WkSh_Z.Cells(1, WkSh_Z.Columns.Count).End(xlToLeft).Column + 1
   Call Intersect(WkSh_Q.Range("A:G"), WkSh_Q.UsedRange).Copy(Destination:=WkSh_Z.Cells(1, ErsteLeereSpalte))
  
   Call wb_Z.Close(SaveChanges:=True)
   Application.ScreenUpdating = True
   
   Call MsgBox(Prompt:="Die Daten wurden erfolgreich übergeben.", _
               Buttons:=vbInformation, _
               Title:="  Information für " & Application.UserName)

End Sub