Question

我有以下宏（部分内容被复制）。我想将数据从Limas表移动到Constanta表。康斯坦察表已包含一些信息。通过运行宏，此信息将消失。

如何更改代码，以便将Limas工作表中的信息复制到第一个空行上的康斯坦察表？

Sub Limas()

Dim LSheetMain, LSheet1, LSheet2, LSheet3, LSheet4 As String
Dim LSheet5, LSheet6 As String
Dim LContinue As Boolean
Dim LFirstRow, LRow As Integer
Dim LCurCORow, LCurRRow, LCurRERow, LCurPRow, LCurBRow As Integer

'Set up names of sheets
LSheetMain = "Limas"
LSheet1 = "Constanta"
LSheet2 = "Rastolita"
LSheet3 = "Reghin"
LSheet4 = "Poliesti"
LSheet5 = "Bucharest"
LSheet6 = "Curtiu"

'Initialize variables
LContinue = True
LFirstRow = 2
LRow = LFirstRow
LCurCORow = 2
LCurRRow = 2
LCurRERow = 2
LCurPRow = 2
LCurBRow = 2
LCurCuRow = 2

Sheets(LSheetMain).Select
   'Loop through all column I values until a blank cell is found
While LContinue = True

  'Found a blank cell, do not continue
  If Len(Range("A" & CStr(LRow)).Value) = 0 Then
     LContinue = False

  'Copy and format data
  Else

     '--- "Constanta" ---
     If Range("I" & CStr(LRow)).Value = "Constanta" Then

        'Copy values from columns A, B, C, and H from "Limas" sheet
        Range("A" & CStr(LRow) & ",B" & CStr(LRow) & ",C" & _
          CStr(LRow) & ",H" & CStr(LRow)).Select
        Selection.copy

        'Paste onto "Constanta" sheet
        Sheets(LSheet1).Select
        Range("A" & CStr(LCurCORow)).Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
          SkipBlanks:=False, Transpose:=False
        Range("A1").Select

        'Increment row counter on "Constanta" sheet
        LCurCORow = LCurCORow + 1

        'Go back to "Limas" sheet and continue where left off
        Sheets(LSheetMain).Select

     End If

Answer 1

以这种方式声明变量意味着每行上只有最后一个声明为字符串;所有其他都被声明为变体类型。

Dim LSheetMain, LSheet1, LSheet2, LSheet3, LSheet4 As String
Dim LSheet5, LSheet6 As String

应该是：

Dim LSheetMain As String, LSheet1 As String, LSheet2 As String, LSheet3 As String
Dim LSheet4 As String, LSheet5 As String, LSheet6 As String

关于移动数据的问题，而不是遍历第I列中寻找 Constanta （或其他工作表名称之一）的行，过滤第I列并将可见单元格复制到适当的工作表。由于我们只获得了部分代码，因此我假设您要遍历每个工作表，从 Limas 工作表复制到名称与过滤器相同的工作表。

Sub Limas()
    Dim lr As Long, v As Long, vSheets As Variant

    vSheets = Array("Limas", "Constanta", "Rastolita", "Reghin", "Poliesti", "Bucharest", "Curtiu")

    With Sheets(vSheets(0)).Cells(1, 1).CurrentRegion
        lr = .Rows.Count
        For v = 1 To UBound(vSheets)
            .AutoFilter
            .AutoFilter Field:=9, Criteria1:="=" & vSheets(v), Operator:=xlAnd
            If CBool(Application.Subtotal(103, .Columns(9).Offset(1, 0))) Then
                .Range("A2:C" & lr & ",H2:H" & lr).Copy _
                  Destination:=Sheets(vSheets(v)).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                ' remove commenting to activate deleting the rows after the copy
                '.Offset(1, 0).EntireRow.Delete
            End If
            .AutoFilter
        Next v
    End With

End Sub

我已经注释掉了复制后从 Limas 工作表中删除行的行。测试完之后，您可以取消注释该行。此代码段假定所有这些工作表都存在于工作簿中。

将数据移动到不同工作表中的第一个空行

1 个答案: