如何按格式复制sheet？

lovelfg

附件是有两个sheet，sheet1的A列包含若干文本，sheet2有一个表格，现在要根据sheet1的A列创建表，表名为A列的值，表的内容为sheet2,写了如下代码,但是问题来了，复制的表格的列宽和行高都有了变化，请教如何修改代码使得新复制的表格完全保留原sheet2的格式呢？Sub test()
Dim shname, i, j
On Error Resume Next
j = Sheets("Sheet1").Range("A65535").End(xlUp).Row
    If j > 1 Then
        shname = Sheets("Sheet1").Range("A1:A" & j)
            For i = 1 To UBound(shname)
                If Sheets(shname(i, 1)) Is Nothing Then
                    Sheets.Add after:=Worksheets(Worksheets.Count)
                    ActiveSheet.Name = shname(i, 1)
                    Sheets("Sheet2").UsedRange.Copy ActiveSheet.Range("A1")
                End If
                Next
    ElseIf j <= 1 Then
    Sheets.Add.Name = Sheets("Sheet1").Range("A1")
    Sheets("Sheet1").UsedRange.Copy ActiveSheet
    End If
End Sub

lovelfg

是不是用usedrange这种方法复制不行？

kimmyyang

不用Usedrange，改成：Sheets("Sheet2").cells.copy  ActiveSheet.range("A1")

lovelfg

kimmyyang 发表于 2019-3-18 16:51
不用Usedrange，改成：Sheets("Sheet2").cells.copy  ActiveSheet.range("A1")

测试通过，多谢，但是没搞明白range和cell还有这区别。。。。。。