从一张纸复制数据并粘贴到另一张纸的A列中的第一个空白单元格中 [英] Copy data from one sheet and paste into the first blank cell in column A of another sheet

问题描述

Sub ImportFixed()
'
Sheets("Front-Page").Select
    Sheets("SPROC").Visible = True
Sheets("SPROC").Select
ThisWorkbook.RefreshALL
DoEvents
    'Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    Sheets("SPROC").Select
    Range("J2").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Master-Data-Sheet").Select
    Range("A1914").Select
    ActiveSheet.Paste
    Sheets("SPROC").Select

    Range("N2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Master-Data-Sheet").Columns("N:N").Range("N1914").Paste

    Cells.Select
    Application.CutCopyMode = False
    With Selection.Font
        .Size = 9
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
    End With
    With Selection.Font
        .Name = "Calibri"
        .Size = 9
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Columns("A:H").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

    Columns("M:N").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("L16108").Select
    Range("J2105").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("J2137").Select
    Range("N2137").Select
    Sheets("SPROC").Select
    ActiveWindow.SelectedSheets.Visible = False
    ActiveWindow.ScrollWorkbookTabs Sheets:=-2
    Sheets("Master-Data-Sheet").Select
End Sub

我有一份报告，其中有一张名为SPROC的工作表。每个星期一刷新此工作表，并从SQL查询中抽取当天的数据（该表上的任何其他数据被覆盖）。然后我要做的是选择所有的数据（列A：N - 每周的行数更改，范围不固定），并将其粘贴到名为主数据的工作表的A列中的第一个空白单元格中-片。此第二张表包含前几周的所有数据，并用于在各种其他工作表上填充所有我的数据透视表和图表等。目前我已经录制了一个宏，但是找不到最后一个空行，而是使用一个特定的范围，这意味着当我运行宏时，它会覆盖主数据文件中的数据。任何建议？

I have a report that has a sheet named SPROC. This sheet is refreshed each Monday and pulls through data for that day from a SQL query (any other data on that sheet is overwritten) . What I then want to do is select ALL the data (Columns A:N - The number of rows changes each week so the range isn't fixed) and paste it into the first blank cell in column A on a sheet named Master-Data-Sheet. This second sheet contains ALL the data for previous weeks and is used to populate ALL my pivot tables and graphs etc on various other worksheets. At present I have recorded a Macro but instead of finding the last blank row, it is using a specific range which means that when I run the macro, it overwrites data in the Master Data file. Any Suggestions?

我已经包含了一个VBA代码的副本（它也做了很多其他功能，所以道歉，如果它有点长）。我认为这是20和359行的问题出现，但我不知道该怎么做来解决它（我已经尝试了各种各样的变化）。

I have included a copy of the VBA code (it also does a lot of other functions so apologies if it is a little long). I think it is lines 20 and 359 where the issue is occurring but I have no idea what to do to fix it (I have tried ALL manner of different variations).

推荐答案

相当古典的东西，必须有很多相似的问题，请在记录宏中摆脱卷轴和这样的东西...

Pretty classical matter, must have a lot of similar question and please get rid of scrolls and things like this in record macros...

尝试这样：

Sub Macro2()
'
Dim ShIn As Worksheet
Dim ShOut As Worksheet
Set ShIn = ThisWorkbook.Sheets("SPROC")
Set ShOut = ThisWorkbook.Sheets("Master-Data-Sheet")

'ShIn.Cells(2, 1).End(xlToRight).Column
Dim RgTotalInput As String
Dim RgTotalOutput As String

RgTotalInput = "$A$2:$" & ColLet(ShIn.Cells(1, 1).End(xlToRight).Column) & "$" & ShIn.Cells(Rows.Count, 1).End(xlUp).Row
RgTotalOutput = "$A$" & ShOut.Cells(Rows.Count, 1).End(xlUp).Row + 1

ShIn.Range(RgTotalInput).Copy Destination:=ShOut.Range(RgTotalOutput)


End Sub



Public Function ColLet(ByVal ColNb As Integer) As String
Dim ColLetTemp As String

Select Case ColNb
    Case Is < 27
        ColLetTemp = Chr(64 + ColNb)
    Case Is > 26
        If Int(ColNb / 26) <> ColNb / 26 Then
            ColLetTemp = Chr(64 + Int(ColNb / 26)) & Chr(64 + ColNb - 26 * Int(ColNb / 26))
        Else
            ColLetTemp = Chr(64 + Int(ColNb / 26) - 1) & Chr(64 + 26)
        End If
    Case Else

End Select

ColLet = ColLetTemp
End Function

这篇关于从一张纸复制数据并粘贴到另一张纸的A列中的第一个空白单元格中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！