Question

首先，我不是编码员。我试图获取这段代码的一部分，以在每次运行宏时增加列号。它第一次运行，然后在下次运行时出现Range类错误。另外，我的增量似乎也不起作用。这是完整的代码，其中给出指出错误的部分：

Sub Prep_Report_Rev_B()
'
' Prep_Report_Rev_B Macro
'
' Keyboard Shortcut: Ctrl+g
'

' Declare Variables

Dim xdate As Date
Dim incCol As Integer

' Ensure button not pressed multiple times a day

    xdate = Worksheets("Summary").Range("F6")

    If Month(Date) = Month(xdate) And Year(Date) = Year(xdate) And Day(Date) = Day(xdate) Then
        MsgBox "Report can only be run once per day to prevent data loss"
        GoTo Line1
    End If

' Copy Data to Historical Tab
'  ** Need to increment column number **

    If incCol = 0 Then
        incCol = 1
    Else
        incCol = incCol + 1 '<--increases of 1 each click
    End If

    ActiveSheet.Unprotect "0000"
    Range("L3:L8,L11:L15,L18:L22,L34:L38,L41:L45,L57:L61,L64:L68").Select
    Selection.Copy
    Sheets("Historical Data").Select
    ActiveSheet.Unprotect "0000"

' =========================================================================
    Cells(2, incCol).Offset(0, 5).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False ' <----
' ==========================================================================

    ActiveSheet.Protect "0000"

' Enter current Date on "Summary" Page

    Sheets("Summary").Select
    Range("F6") = Format(Date, "mm/dd/yyyy")
    ActiveSheet.Protect "0000"

' Clear "Previous Service Report Data" tab

    Sheets("Previous Service Report Data").Select
    ActiveSheet.Unprotect "0000"
    Cells.Select
    Selection.ClearContents

' Copy data from "Service Report" to "Previous Service Report"

    Sheets("Service Report Data").Select
    ActiveSheet.Unprotect "0000"
    Columns("A:AK").Select
    Selection.Copy
    Sheets("Previous Service Report Data").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Protect "0000"

' Clear "Service Report Data" to prepare for new data

    Sheets("Service Report Data").Select
    Columns("A:AI").Select
    Selection.ClearContents
    Range("A1").Select
    ActiveSheet.Protect "0000"

' Pull Up webpage

    ActiveWorkbook.FollowHyperlink _
    Address:="google.com"

Line1:

End Sub

任何帮助或建议，将不胜感激。

Answer 1

在此尝试，它将选择的范围移动到新范围。此代码应选择您的范围并将其移至“历史数据表”。确保将set sh = wb.Sheets("NAME OF YOUR SHEET")上的名称更改为工作表的名称。我可能会创建一个测试表来同时测试它们，以确保它们正在按照您想要的去做，并且不会弄乱您的数据。

Dim sh As worksheet
Dim sh1 As worksheet
Dim rng, rng1, rng2, rng3, rng4, rng5, rng6 As range


set wb = ThisWorkbook
set sh = wb.Sheets("NAME OF YOUR SHEET")
set sh1 = wb.Sheets("NAME OF SHEET YOU WANT TO COPY TO")
set rng = sh.Range("L3:L8")
set rng1 = sh.Range("L11:L15")
set rng2 = sh.Range("L18:L22")
set rng3 = sh.Range("L34:L38")
set rng4 = sh.Range("L41:L45")
set rng5 = sh.range("L57:L61")
set rng6 = sh.range("L64:L68")


sh1.Range("A1").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value

sh1.range("B1").Resize(rng1.Rows.Count, rng1.Columns.Count).Cells.Value = rng1.Cells.Value

sh1.range("C1").Resize(rng2.Rows.Count, rng2.Columns.Count).Cells.Value = rng2.Cells.Value

sh1.range("D1").Resize(rng3.Rows.Count, rng3.Columns.Count).Cells.Value = rng3.Cells.Value

sh1.range("E1").Resize(rng4.Rows.Count, rng4.Columns.Count).Cells.Value = rng4.Cells.Value

sh1.range("F1").Resize(rng5.Rows.Count, rng5.Columns.Count).Cells.Value = rng5.Cells.Value

sh1.range("G1").Resize(rng6.Rows.Count, rng6.Columns.Count).Cells.Value = rng6.Cells.Value

编辑-我为您详细说明了这一点，希望如果您需要轻松进行更改以查看代码在做什么，可能有更好的方法来用更少的代码来完成此操作，但是您不使用这种方式复制和粘贴它只是传输数据，速度更快。我将每个范围设置为每一列的第一行。要更改数据放置位置，只需更改sh1.range("G1")

之后的位置

Range类的PasteSpecial方法在宏的第二次运行时失败

1 个答案: