Question

我需要将B列中当前周日期从活动工作表到另一个工作簿/ Sheet1的每一行的数据从A列复制到X.由于在目标工作簿中已有数据，我需要将数据粘贴到第一个空白行中。

我尝试构建代码但是我得到424错误。

我对此非常陌生，我想得到一些帮助。

Sub Copy()
Dim startdate As Date, enddate As Date
Dim rng As Range, destRow As Long
Dim shtSrc As Worksheet, shtDest As Worksheet
Dim c As Range
Set shtSrc = ThisWorkbook.ActiveSheet
Set shtDest = Workbooks(Destination).Sheets(Sheet1)
'find next blank row
destRow = Workbooks(Destination).Sheets(Sheet1).Range("A1").End(xlDown).Row + 1
'start copying to this row
startdate = CDate((Date - Weekday(Date, 2) + 1))
enddate = CDate(Date - Weekday(Date, 2) + 7)
'scan for date column, B in my case
Set rng = Application.Intersect(shtSrc.Range("B:B"), shtSrc.UsedRange)
For Each c In rng.Cells
    If c.Value >= startdate And c.Value <= enddate Then
        c.ActiveSheet.Range("A:X").Copy _shtDest.Cells(destRow, 0)
    End If
Next
End Sub

Answer 1

下划线是换行符。

c.ActiveSheet.Range（＆＃34; A：X＆＃34;）。复制_ shtDest.Cells（destRow，0）

删除它

c.ActiveSheet.Range（＆＃34; A：X＆＃34;）。复制shtDest.Cells（destRow，0）

或者使用它来破坏行并在下一行继续代码的其余部分

c.ActiveSheet.Range（＆＃34; A：X＆＃34;）。复制_

shtDest.Cells（destRow，0）

更新

使用c.EntireRow.Range("A:X")复制与c

相同行中的列（＆＃34; A：X＆＃34;）中的所有单元格

c.EntireRow.Columns("A:X").Copy shtDest.Cells(destRow)

Answer 2

Sub CopyAtoX()
    Dim startdate As Date, enddate As Date
    Dim rng As Range, destRow As Long
    Dim shtSrc As Worksheet, shtDest As Worksheet
    Dim c As Range
    Set shtSrc = ThisWorkbook.ActiveSheet
    Set shtDest = Workbooks("Book1").Sheets("Sheet1") '<~~ replace Book1 with the name of your destination WB, dont forget quotes
    'find next blank row
    destRow = shtDest.Range("A1").End(xlDown).Row + 1
    'start copying to this row
    startdate = CDate((Date - Weekday(Date, 2) + 1))
    enddate = CDate(Date - Weekday(Date, 2) + 7)
    'scan for date column, B in my case
    Set rng = shtSrc.UsedRange.Columns("B")
    For Each c In rng.Cells
        If c.Value >= startdate And c.Value <= enddate Then
            shtSrc.Range("A" & c.Row & ":X" & c.Row).Copy shtDest.Cells(destRow, 1)
        End If
    Next
End Sub

Answer 3

由于范围c在B列，另一种方式是：

c.Offset(,-1).Resize(,24).Copy _ shtDest.Cells(destRow, 1)
destRow = destRow + 1

或者，如果您只想粘贴值（更快）：

shtDest.Cells(destRow, 1).Resize(,24).Value = c.Offset(,-1).Resize(,24).Value
destRow = destRow + 1

使用VBA宏将当前周项复制到新的excel worknook

3 个答案:

更新