將行從一張紙復制到另一張紙，然后在7列后使用Excel中的vba轉到下一行

Question

我有兩張紙，一張裝滿數據，另一張裝滿。 我想通過每7列將其放到下一行來重整另一張工作表上的數據。

這是我的代碼，但是不起作用。 您能幫我發現我犯的錯誤嗎？

Set ws1 = Sheets("F2")
Set ws2 = Sheets("List1")

rangerow = ws1.Range("A" & Rows.Count).End(xlUp).Row
rangecol = ws1.Range("A" & Columns.Count).End(xlToLeft).Column
rangerow2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
rangecol2 = ws2.Range("A" & Columns.Count).End(xlToLeft).Column

For i = 1 To 100
  If j < 8 Then
    ws1.Range("A4").Copy
    ws2.Range("A1").PasteSpecial xlPasteValues
    ws2.Activate
    j = j + 1
  Else
    Row = ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
  End If
  i = i + 1
Next

Answer 1

嘗試這個：

Dim ws1 As Worksheet, ws2 As Worksheet, lastRow As Long, lastCol As Long, i As Long, j As Long
i = 1
j = 1

Set ws1 = Sheets("F2")
Set ws2 = Sheets("List1")

With ws1
    lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With

For Each cell In ws1.Range(Cells(1, 1), Cells(lastRow, lastCol))
    ws2.Cells(i, j) = cell
    j = j + 1
    If j = 8 Then
        i = i + 1
        j = 1
    End If
Next

Answer 2

您可以Set "F2"表中的范圍Set為動態范圍，然后使用For Each C In Rng范圍中的每個單元格。

在此循環中，我有CellCount代表范圍內的單元格編號，每隔7列，我就在此處重置列號：

Col = CellCount Mod 7 ' get the column number , every 7 columns reset the column

並在此處添加1到行：

PasteRow = Int((CellCount - 1) / 7) + 1 ' get the row number

碼

Option Explicit

Sub CopyUpto7Columns()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim Rng As Range, C As Range
Dim LastRow As Long, CellCount As Long
Dim PasteRow As Long, Col As Long

Set ws1 = Sheets("F2")
Set ws2 = Sheets("List1")

With ws1
    ' get dynamic last row
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

    ' set the range object in sheet "F2" up to column 31
    Set Rng = .Range(.Cells(1, 1), .Cells(LastRow, 31))
End With

PasteRow = 1 ' start pasting from the first row
CellCount = 1 ' reset cell count in Range

' loop through range (cell by cell)
For Each C In Rng
    PasteRow = Int((CellCount - 1) / 7) + 1 ' get the row number

    Col = CellCount Mod 7 ' get the column number , every 7 columns reset the column
    If Col = 0 Then Col = 7

    ws2.Cells(PasteRow, Col).Value = C.Value
    CellCount = CellCount + 1
Next C

End Sub

Answer 3

嘗試下面的代碼:)：

Sub test()

Set ws1 = Sheets("F2")
Set ws2 = Sheets("List1")

rangerow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
rangecol = ws1.Cells(1, Columns.Count).End(xlToLeft).Column


ii = 1
jj = 1
For i = 1 To rangerow
  For j = 1 To rangecol

      If jj = 8 Then
        ii = ii + 1
        jj = 1
      End If

      ws1.Cells(i, j).Copy
      ws2.Cells(ii, jj).PasteSpecial xlPasteValues
      jj = jj + 1
   Next j
Next i


 End Sub