财务报表粘贴在老的旁边

所以在这里我有一个vba代码,为不同的公司填充财务报表,当我第一次运行macros时,它将信息从B列粘贴到G,但是当我重新运行它时,它将粘贴到旧数据的右侧列H到M并不删除旧数据。 我希望它删除旧的数据,以便将新的信息粘贴到列B到G,每次运行macros时覆盖旧数据。

以下是我的代码

太感谢了!

Sub finstate() sTicker = Range("A1").Value If sTicker = "" Then MsgBox "No value to look up" Exit Sub End If With ActiveSheet.QueryTables.Add(Connection:= _ "URL;http://www.advfn.com/stock-market/NASDAQ/" & sTicker & "/financials?btn=annual_reports&mode=company_data" _ , Destination:=Range("B2")) .Name = "financials?btn=annual_reports&mode=company_data" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = False .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingAll .WebTables = "6" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With End Sub 

Sub finstate()下添加以下内容:

 Worksheets("your sheet name").Range("B1:G50000").Clear 

看到你使用Activesheet,像这样清除也是一个选项:

ActiveSheet.Columns("B:G").Clear

我认为这是好多了,尤其是对于多个代码的导入数据。

 Sub Macro1() ThisSheet = ActiveSheet.Name Range("A2").Select Do Until ActiveCell.Value = "" Symbol = ActiveCell.Value Sheets(ThisSheet).Select Sheets.Add With ActiveSheet.QueryTables.Add(Connection:= _ "URL;http://www.advfn.com/stock-market/NASDAQ/" & Symbol & "/financials?btn=annual_reports&mode=company_data" _ , Destination:=Range("$A$1")) .Name = "financials?btn=annual_reports&mode=company_data_1" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "6" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With Sheets(ActiveSheet.Name).Name = Symbol Sheets(ThisSheet).Select ActiveCell.Offset(1, 0).Select Loop End Sub 

我的Sheet1看起来像这样:

在这里输入图像说明

脚本运行结束后,您将会看到如下所示的内容:

在这里输入图像说明