Question

我搜索了这个问题的解决方案，但找不到任何有用的东西。

我在Excel工作簿中有5个工作表;其中2个在格式上是相同的，就像其他3个在格式化方面相同;存储的数据因人而异。

我想从每个工作表中选择一些匹配2个条件的范围，然后将它们复制到新工作簿中：

With shtSrc
    For Each c In rng.Cells
        If c.Value >= startdate And c.Value <= enddate And c.Offset(0, 1).Value = "s" Then
            c.Offset(0, -28).Resize(1, 8).Copy _
                shtDest.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
            c.Offset(0, 0).Copy _
                shtDest.Cells(Rows.Count, 9).End(xlUp).Offset(1, 0)
        End If
    Next
End With

不幸的是，这导致只复制选定（活动）工作表中的单元格，而不是从其他工作表中获取单元格。

我也尝试过不同的代码（例如For i = 1 to SheetCount），但我得到的是从一张纸上复制5次相同的单元格而忽略其他纸张。

这是完整的代码。如果有人能提供帮助就会很棒。

Sub FATTprova()
Dim startdate As Date
Dim enddate As Date
Dim rng As Range
Dim shtSrc As Worksheet
Dim shtDest As Worksheet
Dim c As Range
Dim ws As Worksheet
Dim i As Integer
Dim shCount As Integer
'shCount = ActiveWorkbook.Worksheets.Count
Set shtSrc = ActiveWorkbook.ActiveSheet
Set shtDest = Workbooks.Add.Sheets("Foglio1")
startdate = CDate(InputBox("Inizio periodo dd/mm/yyyy"))
enddate = CDate(InputBox("Fine periodo dd/mm/yyyy"))

    For Each ws In ActiveWorkbook.Worksheets
    'For i = 1 To shCount
    ws.Activate
    'shtSrc.Activate

If shtSrc.name = "CLIENTS" Or shtSrc.name = "SUPPLIERS" Then
    Set rng = Application.Intersect(shtSrc.Range("AE:AE"), shtSrc.UsedRange)
Else
    Set rng = Application.Intersect(shtSrc.Range("AD:AD"), shtSrc.UsedRange)
End If

With shtSrc
    For Each c In rng.Cells
        If c.Value >= startdate And c.Value <= enddate And c.Offset(0, 1).Value = "s" Then
            c.Offset(0, -28).Resize(1, 8).Copy _
                shtDest.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
            c.Offset(0, 0).Copy _
                shtDest.Cells(Rows.Count, 9).End(xlUp).Offset(1, 0)
        End If
    Next
End With

     Next ws
End Sub

Answer 1

我认为问题在于：

Set shtSrc = ActiveWorkbook.ActiveSheet

你告诉Excel＆＃34; ShtSrc＆＃34;永远是活动表，你永远不会告诉Excel＆＃34; ShtSrc＆＃34;正在改变循环。

我会离开＆＃34; ws＆＃34;变量，你不需要＆＃34; ShtSrc＆＃34;和合

稍微更改了您的代码：

    Sub FATTprova()
    Dim startdate As Date
    Dim enddate As Date
    Dim rng As Range
    Dim shtSrc As Worksheet
    Dim shtDest As Worksheet
    Dim c As Range
    Dim ws As Worksheet
    Dim i As Integer
    Dim shCount As Integer

    'shCount = ActiveWorkbook.Worksheets.Count
    Set shtSrc = ActiveWorkbook.ActiveSheet
    Set shtDest = Workbooks.Add.Sheets("Foglio1")
    startdate = CDate(InputBox("Inizio periodo dd/mm/yyyy"))
    enddate = CDate(InputBox("Fine periodo dd/mm/yyyy"))


    For Each ws In ActiveWorkbook.Worksheets
        ws.Select ' I WOULD RECOMMEND USING WITH STATEMENT

        MsgBox (ws.Name) ' THIS IS JUST TO MAKE SURE THE MACRO IS SELECTING EACH SHEET

    If ws.Name = "CLIENTS" Or ws.Name = "SUPPLIERS" Then
            Set rng = Application.Intersect(ws.Range("AE:AE"), ws.UsedRange)
        Else
            Set rng = Application.Intersect(ws.Range("AD:AD"), ws.UsedRange)

    With ws
        For Each c In rng.Cells
            If c.Value >= startdate And c.Value <= enddate And c.Offset(0, 1).Value = "s" Then
                c.Offset(0, -28).Resize(1, 8).Copy _
                    shtDest.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                c.Offset(0, 0).Copy _
                    shtDest.Cells(Rows.Count, 9).End(xlUp).Offset(1, 0)
            End If
        Next
    End With

    End If

         Next ws

    End Sub

从不同的工作表复制选定的范围

1 个答案: