繁体   English   中英

将列复制到最后一行从一张纸到另一张纸

[英]Copying Columns till last row from one sheet to another

我遇到以下问题。 我有一个数组 KWarray,其中包含周数。 该数组用于在“导入”表中设置过滤器。 我的宏现在会自动将过滤器设置为数组的每个元素,创建一个新工作表,并将几列(仅包含数据)复制到这个新工作表中。 我这样做是因为原始数据包含很多我不需要的不必要的基于机器的列。 使用复制的数据,我需要稍后制作图表。 但是现在,每次我运行宏时,都会出现“运行时错误 1004”“应用程序定义或对象定义错误”。 你们能看到错误吗?

Dim x As Long
Dim lrow2 As Long
Dim ws As Worksheet
Dim lrowC As Long

Dim Data1 As Range
Dim Data2 As Range

For x = LBound(KWarray) To UBound(KWarray)

    Sheets("Import").Range("A:AS").Autofilter Field:=2, Criteria1:=KWarray(x)
    'lrowC = Sheets("Import").Cells(Rows.count, 1).End(xlUp).Row
    
    Sheets.Add(After:=Sheets("Import")).Name = "Messwerte KW " & KWarray(x)
    

    With Sheets("Import")
        .Range("A:A" & Cells(Rows.count, "A").End(xlUp).Row).Copy Sheets("Messwerte KW " & KWarray(x)).Range("A:A")
        .Range("C:C" & Cells(Rows.count, "A").End(xlUp).Row).Copy Sheets("Messwerte KW " & KWarray(x)).Range("B:B")
        .Range("R:R" & Cells(Rows.count, "A").End(xlUp).Row).Copy Sheets("Messwerte KW " & KWarray(x)).Range("C:C")
        .Range("S:S" & Cells(Rows.count, "A").End(xlUp).Row).Copy Sheets("Messwerte KW " & KWarray(x)).Range("D:D")
        .Range("T:T" & Cells(Rows.count, "A").End(xlUp).Row).Copy Sheets("Messwerte KW " & KWarray(x)).Range("E:E")
        .Range("U:U" & Cells(Rows.count, "A").End(xlUp).Row).Copy Sheets("Messwerte KW " & KWarray(x)).Range("F:F")
    End With

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM