Excel'de bir satırdan diğerine birkaç satır kopyalamak için kod

Question

İlk olarak, okuma ve sunulan yardım için teşekkürler.

Burada temel olarak clueless değilim. Son birkaç günü, ne yapmak istediğimi kodlamayı öğrenmek için harcadım ve açık bir şekilde açıklamaya çalışacağım.

Çalışma kitabımın çok sayıda kağıdı var, ancak bunlardan sadece ikisi ilgiyle ilgili: Schedule & Shift.

Zamanlamada, bir sütunda çalışanların adını (sütun A), baş harflerini (B), çalışan sayısını (C), vardiyalarını (D) ve vardiya saatlerini içeren 17 sütun ve 40-100 satır vardır. E - vlookup ile başka bir sayfaya iade edilir).

Temel olarak, bu 5 sütunun her birinden verileri "A3" den başlayarak ÜstKrktr sayfasına kopyalayan bir düğme istiyorum ve satırları adlarına göre boş bir alana ulaşıncaya kadar Satır öğesinde kopyalamaya devam edeceğim sütun A).

Şimdiye kadar, ben ilk satır ve aşağıdaki kodla ikinci satır kopyalama idare ettik: aslında ben ötesinde istediğini

Private Sub CommandButton1_Click() 
Dim i As Integer, IntName As String, IntInit As String, IntID As Integer, Shift As String, Hours As Integer 
    Worksheets("Schedule").Select 
    i = 1 
    IntName = Range("a4") 
    IntInit = Range("b4") 
    IntID = Range("C4") 
    Shift = Range("D4") 
    Hours = Range("E4") 

    Do While i < 5 

    Worksheets("Shift").Select 
    Worksheets("Shift").Range("a2").Select 

    If Worksheets("Shift").Range("a2").Offset(1, 0) <> "" Then 
    Worksheets("Shift").Range("a2").End(xlDown).Select 
    End If 

    ActiveCell.Offset(1, 0).Select 
    ActiveCell.Value = IntName 
    ActiveCell.Offset(0, 1).Select 
    ActiveCell.Value = IntInit 
    ActiveCell.Offset(0, 1).Select 
    ActiveCell.Value = IntID 
    ActiveCell.Offset(0, 1).Select 
    ActiveCell.Value = Shift 
    ActiveCell.Offset(0, 1).Select 
    ActiveCell.Value = Hours 
    Worksheets("Schedule").Select 

    IntName = Worksheets("Schedule").Range("a4").Offset(1, 0) 
    IntInit = Worksheets("Schedule").Range("b4").Offset(1, 0) 
    IntID = Worksheets("Schedule").Range("c4").Offset(1, 0) 
    Shift = Worksheets("Schedule").Range("d4").Offset(1, 0) 
    Hours = Worksheets("Schedule").Range("e4").Offset(1, 0) 

    i = i + 1 

    Loop 



End Sub 

Açıkçası, bu aksak ve yapmaz Döngüden ikinci kez.

Doğru yönde hareket etmeme yardımcı olacak herhangi bir öneri veya işaretçi var mı?

Tekrar teşekkürler.

Answer 1

Doğru yoldasınız, sadece döngüyü başka bir döngüde yuvalamalısınız. Ayrıca, Bruce Bruce'un tavsiyesi.

Private Sub CommandButton1_Click() 
    Dim i As Integer 
    Dim intCounter As Integer 
    Dim IntName As String 
    Dim IntInit As String 
    Dim IntID As Integer 
    Dim Shift As String 
    Dim Hours As Integer 

    'Adjust intCounter if you want to start on a row other than 1 
    intCounter = 1 

    Do 
     With Worksheets("Schedule") 
      IntName = .Cells(intCounter, 1).Value 
      IntInit = .Cells(intCounter, 2).Value 
      IntID = .Cells(intCounter, 3).Value 
      Shift = .Cells(intCounter, 4).Value 
      Hours = .Cells(intCounter, 5).Value 
     End With 

     If IntName = "" Then Exit Do 

     i = 1 
     Do While i < 5 
      'No need to use offset when you can just reference the cell directly. 
      'Also, not sure why you select this column anyhow. 
      'These lines can probably be deleted? 
      'If Worksheets("Shift").Range("a3").Value <> "" Then 
      ' Worksheets("Shift").Range("a2").End(xlDown).Select 
      'End If 

      'Avoid using things like Select, ActiveCell, and ActiveSheet. 
      'What if someone clicks on something while your code is running?? Oops! 
      With Worksheets("Shift") 
       .Cells(i + 1, 2).Value = IntName 
       .Cells(i + 1, 3).Value = IntInit 
       .Cells(i + 1, 4).Value = IntID 
       .Cells(i + 1, 5).Value = Shift 
       .Cells(i + 1, 6).Value = Hours 
      End With 

      i = i + 1 
     Loop 

     'Increment to go to the next row of Schedule 
     intCounter = intCounter + 1 
    Loop 
End Sub 

Answer 2

kompakt kodu hakkında Tim'in endişe tarafından getirilen, denemek bu

Private Sub CommandButton1_Click() 

With Worksheets("Schedule").Range("A4:E4").CurrentRegion 
    .Offset(1).Resize(.Rows.Count - 1).Copy Destination:=Worksheets("Shift").Range("A3") 
End With 

End Sub