首页 文章

循环单元格在每个工作表中的范围和循环

提问于
浏览 次
-1

为什么代码不会在下一个工作表中选择单元格？我的副本工作簿包含12个工作表 . Sheet.Name = ("cat","rabbit","cow","sheep"...+8) .

每张表都有相同的 Headers . Col(B1:AK1)= year(1979,1980,...2014) .

在我反复打开粘贴的另一个文件夹中; File.Name = (1979.xlsx, 1980.xlsx,..,2014.xlsx) .

在每张纸上有12列 . Col(B1:M1)= ("cat","rabbit","cow","sheep"...+8) .

范围内的每个单元格都很好地循环，但工作表似乎并非如此 . 当我的代码完成运行时，我检查从 worksheet("cat") 粘贴具有相同数据的工作簿 . 我不能胜任编码，所以无论何时我的代码都可以改进，请告知我 .

Sub transferPict()

Dim wsC As Integer
Dim cell As Range
Dim Rng As Range 
Dim j, i As Long
Dim x As String
Dim Folderpath
Dim file As String    

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

wsC = ThisWorkbook.Sheets.Count
For j = 1 To wsC
i = j + 1
Set Rng = Range("B1:AK1")
For Each cell In Rng
    x = cell.Value
    cell.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    Folderpath = "F:\Sony Pendrive\Data Baru\Tahun\PasteTahun\"
    file = Folderpath & x & ".xlsx"
    Workbooks.Open (file)
    ActiveWorkbook.Worksheets("sheet1").Select
        ActiveSheet.Cells(2, i).Select
        ActiveSheet.Paste
        ActiveWorkbook.Close saveChanges:=True

 Next cell
 Next j

Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub
excel vba excel-vba loops

1 回答

  • 0

    在您的代码中，您没有指定要从中复制的工作表，因此它将始终使用“活动”工作表 .

    希望此代码能够解决您的问题：

    Sub transferPict()
    Dim wsC As Integer
    Dim cell As Range
    Dim Rng As Range
    'Dim j, i As Long ' <--- This is equivalent to Dim j As Variant, i As Long
    Dim j As Long, i As Long
    Dim x As String
    Dim Folderpath
    Dim file As String

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    wsC = ThisWorkbook.Sheets.Count
    For j = 1 To wsC
        i = j + 1
        Set Rng = ThisWorkbook.Sheets(j).Range("B1:AK1")
        For Each cell In Rng
            x = cell.Value
            ThisWorkbook.Sheets(j).Range(cell.Offset(1, 0), cell.Offset(1, 0).End(xlDown)).CopyPicture Appearance:=xlScreen, Format:=xlPicture

            Folderpath = "F:\Sony Pendrive\Data Baru\Tahun\PasteTahun\"
            file = Folderpath & x & ".xlsx"
            Workbooks.Open file
            ActiveWorkbook.Worksheets("sheet1").Cells(2, i).PasteSpecial
            ActiveWorkbook.Close saveChanges:=True
        Next cell
    Next j

    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub
    回复于

相关问题