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

我有以下macros（部分被复制）。 我想将数据从利马表单移动到康斯坦察表单。 康斯坦塔表已经包含一些信息。 通过运行这个macros，这个信息就消失了。

如何更改代码，以便将利马表中的信息复制到第一个空白行上的康斯坦塔表中？

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

以这种方式声明variables意味着每行只有最后一个被声明为一个string; 所有其他的都被声明为变体types。

 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工作表复制到与您的filter命名相同的工作表。

 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 

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